使用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文件数据复制到单个文件

回答

相关问题