Copying worksheets from multiple workbooks into current workbook - excel

Question

Copying worksheets from multiple workbooks into current workbook
Hi I was wondering if anybody if you guys could help me out?
Im trying to copy multiple workbooks and just save it into only one worksheet.
I have 2000 diffrent workbooks with the diffrent amount of rows, The ammount of cells is the same and it dosent change and they are all at the first sheet in every workbook.
Im new with this kind of stuff so i'm thankfull for all help u can offer, I cant make it work. I'm using excel 2010
This is what I got atm:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = “C:\test\”
MyFile = Dir("test\")
Do While Len(MyFile) > 0
If MyFile = "master.xlsm" Then
Exit Sub
End If
Range(Range("a1"), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Name = "PivotData"
Workbooks.Open (Filepath & MyFile)
Range("A2:AD20").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))
MyFile = Dir
Loop End
Sub

Answer 1

I've re-written your code by applying what I posted in the comment.
Try this out: (I stick with your logic using the DIR function)
Sub test()
Dim MyFile As String, MyFiles As String, FilePath As String
Dim erow As Long
'~~> Put additional variable declaration
Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet
FilePath = "C:\test\"
MyFiles = "C:\test\*.xlsx"
MyFile = Dir(MyFiles)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
'~~> Set your declared variables
Set wbMaster = ThisWorkbook 'if you want to consolidate files in this workbook
Set wsMaster = wbMaster.Sheets("Sheet1") 'replace Sheet1 to suit
Do While Len(MyFile) > 0
'Debug.Print MyFile
If MyFile <> "master.xlsm" Then
'~~> Open the file and at the same time, set your variable
Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
Set wsTemp = wbTemp.Sheets(1) 'I used index, you said there is only 1 sheet
'~~> Now directly work on your object
With wsMaster
erow = .Range("A" & .Rows.Count).End(xlUp).Row 'get the last row
'~~> Copy from the file you opened
wsTemp.Range("A2:AD20").Copy 'you said this is fixed as well
'~~> Paste on your master sheet
.Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues
End With
'~~> Close the opened file
wbTemp.Close False 'set to false, because we opened it as read-only
Set wsTemp = Nothing
Set wbTemp = Nothing
End If
'~~> Load the new file
MyFile = Dir
Loop
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
I've commented the code to help you modify it to suit your needs.
I you got stuck again, then just go back here and clearly state your problem.

Answer 2

Try this out:
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 ".xlsx files", "*.xlsx"
.Show
End With
'error trap - don't 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're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")
End Sub