0

我有 50 个 excel 工作簿，每个里面包含 5 张工作表。它们都具有相同的结构、相同的工作表名称、相同的列标题。我需要从每个文件中提取第四张表，并将数据放在一个单张工作簿中。我找到了这个宏，但它在不同的工作表上提取。我不知道如何修改此代码以满足我的需要。有人可以建议吗？

Sub CombineWorkbooks() 
Dim FilesToOpen 
Dim x As Integer 
On Error GoTo ErrHandler 
Application.ScreenUpdating = False 
FilesToOpen = Application.GetOpenFilename _ 
              (FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _ 
               MultiSelect:=True, Title:="Files to Merge") 
If TypeName(FilesToOpen) = "Boolean" Then 
    MsgBox "No file is chosen" 
    GoTo ExitHandler 
End If 
x = 1 
While x <= UBound(FilesToOpen) 
    Workbooks.Open Filename:=FilesToOpen(x) 
    Sheets("Associates report").Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    x = x + 1 
Wend 
ExitHandler: 
    Application.ScreenUpdating = True 
    Exit Sub 
ErrHandler: 
    MsgBox Err.Description 
    Resume ExitHandler 
End Sub code here
4

1 回答 1

0

这是一个用于从特定文件夹中的所有文件中收集数据的宏。

工作簿到 1 张

需要编辑的代码部分用颜色来引起您的注意。在“这是要自定义的部分”中，代码​​：

LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)

...从第 4 页复制需要是这样的：

LR = Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Row  'Find last row
Sheets("Sheet4").Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)

或者查看上面的示例代码，也许：

LR = Sheets("Associates Report").Range("A" & Rows.Count).End(xlUp).Row  'Find last row
Sheets("Associates Report").Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)

它旨在作为一个通用的起点，您将不得不为您的环境进行编辑。检查评论。

于 2012-08-06T14:31:17.800 回答