将动态范围的表格复制到单张

时间:2017-06-21 18:52:28

标签: excel vba excel-vba

我正在尝试将不同工作表上的几个不同部件列表合并到一个主列表中。

问题在于,有时,例如,主框架部件或装饰部件将具有多个板(例如主框架,主框架(2),修剪,修剪(2),修剪(3)等),用于不同的部分。

所以我不能像我之前想的那样对硬编码进行硬编码,因为每张工作簿的工作表数量各不相同。我复制的第一张纸和我复印的最后一张纸是相同的,但是根据工作簿,它们可能是之前的纸张,并且总是在它之后的纸张我不想包括所以我不能从最后一张纸或始终以第一张纸开头。

我不是VBA专家,它看起来足够强大,可以解决我的问题,我只是不知道如何具体去做。

我已将逻辑附加到我目前用于将所有工作表连接成一个代码的代码中,但它不够动态,无法适用于每种情况。 (对于糟糕的风格也很抱歉)

非常感谢任何帮助或只是正确方向上的一点。

    On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Master"
Sheets(2).Activate
' Add copy logo once here.

Range("A6").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1").End(xlUp)(1)
For j = 2 To 13 ' Range of sheets
Sheets(j).Activate
Range("A6").Select
Selection.CurrentRegion.Select

' Adjust here to eliminate header but include 2 rows below it
Selection.Offset(5, 0).Resize(Selection.Rows.Count - 5).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(6)
Next

Sheets(1).Activate
Range("A1:O1").Select
Range("O1").Activate
Selection.Delete Shift:=xlUp
Range("O10").Select

Range("A1:O4").Select
Range("O4").Activate
Selection.Delete Shift:=xlUp

1 个答案:

答案 0 :(得分:0)

试试这个。这将循环通过纸张,直到它看到第一张纸张,然后开始循环遍历所有纸张,直到它完成最后一张纸张,之后它将停止运行。只需将工作表名称放在那里。

Dim ws_count As Integer
Dim j as integer
Dim k as integer
ws_count = ActiveWorkbook.Worksheets.Count

For k = 1 to ws_count
    If Sheets(k).Name = "FirstSheet" Then
        For j = k to ws_count
            Sheets(j).Activate
            Range("A6").Select
            Selection.CurrentRegion.Select

            ' Adjust here to eliminate header but include 2 rows below it
            Selection.Offset(5, 0).Resize(Selection.Rows.Count - 5).Select
            Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(6)
            If Sheets(j).Name = "LastSheet" Then
                Exit For 
            End If
        Next j
    Exit For
    End If
Next k