Option
Explicit
Sub
GetItBetter()
Const
C_SrcTtl
As
Boolean
=
True
Const
C_TrgTtl
As
Boolean
=
False
Dim
oDlg
As
FileDialog, V
Dim
oWbData
As
Excel.Workbook
Dim
oWsData
As
Excel.Worksheet, oWsResult
As
Excel.Worksheet
Dim
rngFrom
As
Range, rngTo
As
Range
Dim
lngTo
As
Long
, lngFrom
As
Long
Dim
bln
As
Boolean
: bln = Application.ScreenUpdating
Application.ScreenUpdating =
False
On
Error
GoTo
fail
lngFrom = IIf(C_SrcTtl, 2, 1)
lngTo = IIf(C_TrgTtl, 1, 0)
Set
oWsResult = ThisWorkbook.Sheets(1)
With
oWsResult
Set
rngTo = .Cells(1 + lngTo, .Columns.Count).
End
(xlToLeft)
If
rngTo.Value <>
""
Then
Set
rngTo = rngTo.Offset(, 1)
End
With
Set
oDlg = Application.FileDialog(msoFileDialogOpen)
With
oDlg
.AllowMultiSelect =
True
.Filters.Clear
.Filters.Add
"Excel-Datei(en)"
,
"*.xls?"
.Show
For
Each
V
In
.SelectedItems
Set
oWbData = Workbooks.Open(V)
With
oWbData
Set
oWsData = Sheets(1)
With
oWsData.Columns(
"C"
)
Set
rngFrom = Range(.Cells(lngFrom), .Cells(lngFrom).
End
(xlDown))
End
With
rngFrom.Copy rngTo
.Close
False
End
With
Set
rngTo = rngTo.Offset(, 1)
Next
End
With
On
Error
GoTo
0
fail:
Application.ScreenUpdating = bln
End
Sub