Copy data from Multiple Workbooks

[rudevincy]

I have a worksheet called Paste_Data in a workbook that I have opened, I would like to copy data from 7 different workbooks from a sheet called AD_Change and paste the combined data to the Paste_Data worksheet.

I found code but need help to change it a bit so it works... Please someone help... the code is below


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 = 7
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 ".xlsx files", "*.xlsx"
.Show
End With

'error trap - don't allow user to pick more than 7 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 = ThisWorkbook.Sheets("Paste_Data")
Set OutSheet = OutBook.Sheets(6)

'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're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")

End Sub

 

[pvr928]

Macro to Combine Data from Different Workbooks into One Workbook

Hi rudevincy

It would be helpful if you could let everyone know why the code you have posted does not work. Placing the code in code tags will also make it easier for people to comprehend. If the code is producing errors, please identify both the line at which the error occurs as well as the description of the error.

An alternative approach would be to consider Power Query (a free Excel add-in from MS available for Excel 2010 and beyond ) - it sounds like Power Query will do this very easily and will obviate the need for VBA.

Cheers

pvr928

 

[Fluff]

Duplicate post https://www.mrexcel.com/forum/excel...-workbooks-into-one-workbook.html#post5000028

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).

If you do not receive a response, you can "bump" it by replying to it again, though we advise you to wait 24 hours before doing and not to bump a thread more than once a day.

As you have more information on the other thread I have locked this one