Hi all,
I found this code that does most of the work, but it copies the whole workbook data. All I need is to target specific cell ranges (such as A2 and A10 and A14:D14 and A22) from the target workbooks and add the data inside the table of the destination worksheet. All the target workbooks are inside one folder and named in sequence (1.csv, 2.csv, etc):
Option Explicit
Sub CombineDataFiles()
Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
LastDataRow As Long, LastDataCol As Long, _
HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range
'initialize constants'
MaxNumberFiles = 2001
HeaderRow = 1 'assume headers are always in row 1'
LastOutRow = 1
'prompt user to select files'
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
.AllowMultiSelect = True
.Title = "Multi-select target data files:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".csv files", "*.csv"
.Show
End With
'error trap - do not allow user to pick more than 2000 files'
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
MsgBox ("Too many files selected, please pick more than " &
MaxNumberFiles & ". Exiting sub...")
Exit Sub
End If
'set up the output workbook'
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)
'loop through all files'
For FileIdx = 1 To TargetFiles.SelectedItems.Count
'open the file and assign the workbook/worksheet'
Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
Set DataSheet = DataBook.ActiveSheet
'identify row/column boundaries'
LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Column
'if this is the first go-round, include the header'
If FileIdx = 1 Then
Set DataRng = Range(DataSheet.Cells(HeaderRow, 1),
DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(HeaderRow, 1),
OutSheet.Cells(LastDataRow, LastDataCol))
'if this is NOT the first go-round, then skip the header'
Else
Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1),
DataSheet.Cells(LastDataRow, LastDataCol))
Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1),
OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
End If
'copy the data to the outbook'
DataRng.Copy OutRng
'close the data book without saving'
DataBook.Close False
'update the last outbook row'
LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
Next FileIdx
'let the user know we are done!'
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")
End Sub