将多张精装excel工作簿中的数据提取到一张单张工作簿中

我有50张excel工作簿，每张工作簿中包含5张工作表。它们都具有相同的结构，相同的图表名称，相同的列标题。我需要从每个文件中提取第四个工作表，并将数据放在一个单独的工作表中。我发现这个宏，但它提取在不同的工作表上。我无法弄清楚如何修改这段代码以适应我的需求。有人可以请指教吗？将多张精装excel工作簿中的数据提取到一张单张工作簿中

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

来源

2012-08-06 Elena B

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

Workbooks to 1 Sheet

的代码需要被编辑的部分有色提请您注意。在“这是自定义部分”，代码：

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-06 14:31:17

将多张精装excel工作簿中的数据提取到一张单张工作簿中

回答

相关问题