Copy multiple xls files data to single file using VBA - vba

Question

I have Multiple files in a folder.i wants to copy all Files data (i.e.all columns to new sheet) to one new sheet.
E.g. file 1 Contains 5 columns of data and file 2 contains 10 columns of data and so on. this data should copy on new sheet like first 5 columns are from file 1 and then on the same sheet from column 6, the file2 data should be copy and so on.
i tried but facing some problems like i am able to copy first file data successfully but when i am going to second file , second file data is overwriting on first file. i want second file data to the next column.
Below is my code
Public Sub CommandButton1_Click()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim mainwb As Workbook
Dim ws As Worksheet
Dim search_result As Range 'range search result
Dim blank_cell As Long
Dim wb As Workbook
Path = "C:\Test\"
Filename = Dir(Path & "*.xls")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
Set wbk = ActiveWorkbook
sheetname = ActiveSheet.Name
wbk.Sheets(sheetname).Activate
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To Lastrow
wbk.Sheets(sheetname).UsedRange.Copy
Workbooks("aaa.xlsm").Activate
Set wb = ActiveWorkbook
sheetname1 = ActiveSheet.Name
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
wb.Sheets(sheetname1).Range("A1").Select
wb.Sheets(sheetname1).Paste
Next i
ActiveCell.Offset(0, 1).Select
wbk.Close SaveChanges:=False
Filename = Dir
Loop
End Sub
plz help me......
Thanks in Advance

Answer 1

With the For i = 1 To Lastrow loop you are pasting the content several times and I was unable to correct it without significant change. As a result may I recommend using the below sample, I have added comments to describe what is happening.
Public Sub Sample()
Dim Fl As Object
Dim Fldr As Object
Dim FSO As Object
Dim LngColumn As Long
Dim WkBk_Dest As Excel.Workbook
Dim WkBk_Src As Excel.Workbook
Dim WkSht_Dest As Excel.Worksheet
Dim WkSht_Src As Excel.Worksheet
'Using FileSystemObject to get the folder of files
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder("C:\Users\Gary\Desktop\New folder\")
'Setting a reference to the destination worksheet (i.e. where the
'data we are collecting is going to)
Set WkBk_Dest = ThisWorkbook
Set WkSht_Dest = WkBk_Dest.Worksheets("Sheet1")
'Look at each file in the folder
For Each Fl In Fldr.Files
'Is it a xls, xlsx, xlsm, etc...
If InStr(1, Right(Fl.Name, 5), ".xls") <> 0 Then
'Get the next free column in our destination
LngColumn = WkSht_Dest.Cells(1, WkSht_Dest.Columns.Count).End(xlToLeft).Column
If LngColumn > 1 Then LngColumn = LngColumn + 1
'Set a reference to the source (note in this case it is simply selected the first worksheet
Set WkBk_Src = Application.Workbooks.Open(Fl.Path)
Set WkSht_Src = WkBk_Src.Worksheets(1)
'Copy the data from source to destination
WkSht_Src.UsedRange.Copy WkSht_Dest.Cells(1, LngColumn)
Set WkSht_Src = Nothing
WkBk_Src.Close 0
Set WkBk_Src = Nothing
End If
Next
Set WkSht_Dest = Nothing
Set WkBk_Dest = Nothing
Set Fldr = Nothing
Set FSO = Nothing
End Sub