Как сказал БигБен, вам нужно найти пустой конечный столбец. Это можно сделать в VBA, используя
ColumnNumber = ws.Cells(7, Columns.Count).End(xlToLeft).Column + 1
, что аналогично нажатию клавиши Ctrl-Left в ячейке XFD7. Взгляните на With .. End With blocks, чтобы избежать повторения названия объектов. Массивы также могут быть полезны, например -
Option Explicit
Sub Get_Data_From_File()
Const SHEET_NAME = "WW_MASTER"
Dim wb As Workbook, ws As Worksheet
Dim wbForm As Workbook, wsForm As Worksheet
Dim sFilename As String, map As Variant
Dim iTargetCol As Integer, t0 As Single, msg As String
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
iTargetCol = ws.Cells(7, Columns.Count).End(xlToLeft).Column + 1
sFilename = Application.GetOpenFilename(Title:="Browse for your File & Import", _
FileFilter:="Excel Files(*.xls*),*xls*")
If sFilename = "False" Then
MsgBox "No file selected", vbCritical
End If
' master row, form range, form sheet
map = Array( _
7, "C6:C12", 1, _
16, "G16:G29", 1, _
33, "O19:O24", 2, _
40, "O29:O32", 2, _
45, "C36:C45", 2, _
58, "C34:C36", 2, _
62, "C38:C40", 2, _
66, "C42:C44", 2, _
72, "C50:C52", 2, _
76, "C54:C56", 2, _
81, "O50:O54", 2)
Application.ScreenUpdating = False
t0 = Timer
' copy using mapping rules
Dim i As Integer, n As Integer
Set wbForm = Workbooks.Open(sFilename, False, True) ' read only
For i = LBound(map) To UBound(map) Step 3
n = map(i + 2) ' sheet no
wbForm.Sheets(n).Range(map(i + 1)).Copy
ws.Cells(map(i), iTargetCol).PasteSpecial
Next
Application.CutCopyMode = False
wbForm.Close False
' end
Application.ScreenUpdating = True
msg = "Imported into column " & iTargetCol & vbCrLf & _
"From " & sFilename
MsgBox msg, vbInformation, "Finished in " & Format(Timer - t0, "0.00") & " secs"
End Sub
Или импортировать в один ряд
Sub Get_Data_From_File2()
Const SHEET_NAME = "Sheet1" '"WW_MASTER"
Dim wb As Workbook, ws As Worksheet
Dim wbForm As Workbook, wsForm As Worksheet
Dim sFilename As String, map As Variant
Dim iTargetRow As Long, t0 As Single, msg As String
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHEET_NAME)
iTargetRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
sFilename = Application.GetOpenFilename(Title:="Browse for your File & Import", _
FileFilter:="Excel Files(*.xls*),*xls*")
If sFilename = "False" Then
MsgBox "No file selected", vbCritical
End If
' master row, form range, form sheet
map = Array( _
1, "D6", 1, _
2, "C8:C14", 1, _
9, "O19:O24", 2)
' 40, "O29:O32", 2, _
' 45, "C36:C45", 2, _
' 58, "C34:C36", 2, _
' 62, "C38:C40", 2, _
' 66, "C42:C44", 2, _
' 72, "C50:C52", 2, _
' 76, "C54:C56", 2, _
' 81, "O50:O54", 2)
Application.ScreenUpdating = False
t0 = Timer
' copy using mapping rules
Dim i As Integer, n As Integer, k As Integer, var As Variant, rng As Range
Set wbForm = Workbooks.Open(sFilename, False, True) ' read only
For i = LBound(map) To UBound(map) Step 3
n = map(i + 2) ' sheet no
Set rng = wbForm.Sheets(n).Range(map(i + 1))
If rng.Rows.Count = 1 Then
ws.Cells(iTargetRow, map(i)) = rng.Value
Else
var = WorksheetFunction.Transpose(rng)
' fill columns
For k = LBound(var) To UBound(var)
ws.Cells(iTargetRow, map(i) + k - 1) = var(k)
Next
End If
Next
Application.CutCopyMode = False
wbForm.Close False
' end
Application.ScreenUpdating = True
msg = "Imported into Row " & iTargetRow & vbCrLf & _
"From " & sFilename
MsgBox msg, vbInformation, "Finished in " & Format(Timer - t0, "0.00") & " secs"
End Sub