首页 文章

从多个sheeted excel工作簿中提取数据到一个单独的工作簿中

提问于
浏览
0

我有50个excel工作簿,每个工作簿里面有5张 . 它们都具有相同的结构,相同的工作表名称,相同的列 Headers . 我需要从每个文件中提取第4张纸,并将数据放在一个单独的片状工作簿中 . 我找到了这个宏,但它在不同的纸张上提取 . 我无法弄清楚如何修改此代码以满足我的需求 . 有人可以建议吗?

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

1 回答

  • 0

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

    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)
    

    它旨在作为一个通用的起点,您必须通过并编辑您的环境 . 检查评论 .

相关问题