多个Open Workbooks合并为一个工作表

时间:2017-12-12 16:19:46

标签: vba list loops dynamic

我每天提取多份报告,并且都以“报告”一词开头。它们都具有相同数量的列,只是行数不同。我创建的是一个子程序,它将在开头循环遍历所有打开的工作簿,名称为“report”,并在我的主工作簿“Distribution”中获取连续排序的数据

我让宏完全按照我的需要去做,但我正在寻找指导,使其更具动态性。我每次都要复制的标题行,如果添加了新列,则不会捕获它。与行相同。

我仍然是VBA的新手,但我想我开始越来越了解。对不起,所有评论的部分。任何有用的指示将不胜感激。

Private Sub CommandButton3_Click()
'Get Data button
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim nrow As Long

    Set wsh = ActiveWorkbook.Worksheets("Data")
screen 0 'turns off calculation and screen updating
nrow = 2
    For Each wbk In Workbooks
        If Left(wbk.Name, 6) = "report" Then
            wbk.Worksheets(1).Range("A1:Z1").Copy _ 'copies the header row
                Destination:=wsh.Range("A1") 'paste data in row 1
            wbk.Worksheets(1).Range("A2:Z500").Copy _ 'copy the rest of the
                Destination:=wsh.Range("A" & nrow) 'paste data next available row
            wbk.Close False
            nrow = wsh.UsedRange.Rows.Count + 1 'Next row to paste next sheet into
        End If
    Next wbk

nrow = 0 ' reset next row

FilterData 'Function to filter unwanted data
screen 1 'Turn on screen updating and calculation

End Sub

1 个答案:

答案 0 :(得分:0)

Private Sub CommandButton3_Click()
'Get Data button
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim nrow As Long

    Set wsh = ActiveWorkbook.Worksheets("Data")
screen 0
    For Each wbk In Workbooks
        If Left(wbk.Name, 6) = "report" Then
            wbk.Worksheets(1).Range("A1:Z1").Copy _
                Destination:=wsh.Range("A1")
            nrow = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
            wbk.Worksheets(1).Range("A2:Z500").Copy _
                Destination:=wsh.Range("A" & nrow)
            wbk.Close False
        End If
    Next wbk

nrow = 0

FilterData
Sheets("admin").Select
screen 1

End Sub