使用VBA將多個xls文件數據複製到單個文件

我有一個文件夾中有多個文件。我想要將所有文件數據（即所有列到新工作表）複製到一個新工作表。例如文件1包含5列數據，文件2包含10列數據等等。這個數據應該複製在新的表格上，比如前5列是來自文件1，然後是來自列6的同一張表格，file2數據應該是複製等等。使用VBA將多個xls文件數據複製到單個文件

我試過但面臨一些問題，如我能夠成功複製第一個文件數據，但是當我要去第二個文件，第二個文件數據覆蓋第一個文件。我想要第二個文件數據到下一列。

下面是我的代碼

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幫助我...... 由於提前

來源

2016-06-22 Amar

您還需要提高Column值。在'wb.Sheets（sheetname1）.Range（「A1」）。選擇''行，您需要將A1修改爲B1和C1等。使用一個簡單的循環，每次打開新的工作簿時將列前移1 Excel文件）。 –

看不清你爲什麼使用For i = 1 To Lastrow Loop – dbmitch

我不明白你的意思.....你可以在我的代碼中進行修改併發布它...謝謝你的回答 – Amar

隨着For i = 1 To Lastrow循環要粘貼的內容好幾次，我無法糾正沒有顯着變化。因此，我建議使用下面的示例，我已經添加了評論來描述發生的事情。

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

來源

2016-06-22 05:23:00

使用VBA將多個xls文件數據複製到單個文件

回答

相關問題