简体   繁体   English

从多个工作表Excel工作簿中提取数据到一个工作表中

[英]extracting data from multiple sheeted excel workbooks into one single sheeted workbook

I have 50 excel workbooks each containing 5 sheets inside. 我有50个excel工作簿,每个工作簿中包含5张纸。 They all have the same structure, same sheet names, same column titles. 它们都具有相同的结构,相同的工作表名称,相同的列标题。 I need to extract the 4th sheet from each file and put data in one single sheeted workbook under each other. 我需要从每个文件中提取第4张工作表,并将数据相互放在一个单独的工作表中。 I found this macro but it extracts on different sheets. 我找到了此宏,但它提取在不同的工作表上。 I can't figure out how to modify this code to fit my needs. 我不知道如何修改此代码以满足我的需求。 Can someone please advise? 有人可以请教吗?

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

Here's a macro for collecting data from all files in a specific folder. 这是一个宏,用于从特定文件夹中的所有文件收集数据。

Workbooks to 1 Sheet 工作簿到1张纸

The parts of the code that need to be edited are colored to draw your attention. 需要编辑的代码部分带有彩色,以引起您的注意。 In the "this is the section to customize", the code: 在“这是要自定义的部分”中,代码​​:

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

...would need to be something like this to copy from sheet 4: ...需要这样的东西才能从工作表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)

Or looking at your sample code above, maybe: 或查看上面的示例代码,也许:

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)

It's intended as a generic starting point, you will have to go through and edit for your environment. 它旨在作为通用起点,您将必须针对您的环境进行遍历和编辑。 Check the comments. 检查评论。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM