Copy many workbooks into one master Workbook

[Solrac3030]

I'm trying to marge a lot of WorkBooks into one master Workbook. The code that I have goes to a folder and copies all of the Workbooks there into the Master Spreadsheet that I have open. Only problem is that it will copy and paste the next workbook on top of the previous past so at the end my master Spreadsheet only shows the data for the last workbook that was copied. I need to modify the code so that it will paste each copied work book below the previous paste. Any help will be greatly appreciated. Thanks.


Sub CopySheets()
'
' CopySheets Macro
'
Dim Folder As Object
Dim File As Object
Dim wb As Workbook
Dim FSO As Object
Dim vCount As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("C:\HR Test")
For Each File In Folder.Files
Application.DisplayAlerts = False
Set wb = Workbooks.Open(Filename:=File.Path)
wb.Worksheets(1).UsedRange.Copy
Windows("Time Record SBC Master.xls").Activate
ActiveSheet.Paste
wb.Close
Next File
End Sub

[lucas]

Reset the path in this code and try it. There must be data in column A as it is used to find the last row of data before pasting again.

It's not exactly like your code but very similar:

Option Explicit
Sub open_workbooks_same_folder()
Dim folder As String
Dim Wb As Workbook, sFile As String
Dim Cwb As Workbook
Dim lrow As Long
folder = ThisWorkbook.Path & "\"
' folder = "C:\Temp\"
Set Cwb = ThisWorkbook
sFile = Dir(folder & "*.xls")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While sFile <> ""
If sFile <> Cwb.Name Then
'If there are sheets without a data sheet
'continue with code to import
'the rest that has a sheet with the name data
On Error Resume Next
Set Wb = Workbooks.Open(folder & sFile)
lrow = Cwb.Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row
lrow = lrow + 1
Wb.Worksheets("Sheet1").UsedRange.Copy
Cwb.Worksheets("Data").Range("A" & lrow + 1).PasteSpecial xlPasteValues
Wb.Close True
End If
sFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Cwb.Worksheets("Data").Range("A1").Select

End Sub

[Solrac3030]

Didn't quite work. Only the last file shows in the Master adn the columns came out very wrong fro some reason. I am attaching a copy of the master as it ended after the code was run and a copy of the one of the data files that is being copied. Hopefully you can help me sort the problem.

[Solrac3030]

Here is a copy of one of the data files.

[Solrac3030]

I found the problem that caused the files to paste all wrong and corrected. Is there a way to just copy columns A through F only?

[lucas]

It might be easier to just delete everything to the right of F.
Add the second line below the line to pastespecial. If y isn't far enough, adjust it.


Cwb.Worksheets("Data").Range("A" & lrow + 1).PasteSpecial xlPasteValues
Cwb.Worksheets("Data").Columns("G:Y").Delete