Question

嗨，我的代码是

遍历所有以“673”
从第5行开始复制所有包含数据的行
将条目粘贴到“颜色”工作表

我遇到以下问题：

代码仅在活动的工作表中运行
不会遍历所有工作表

当它粘贴在“颜色”工作表中时，它会直接粘贴到第2行的标题上。第一个空白行是第3行以后，我希望逻辑粘贴到下一个可用的空白行，因为它穿过床单。

Sub Consolidate()

Dim lastrow As Long
Dim report As Worksheet
Set report = Excel.ActiveSheet

For Each Sheet In ActiveWorkbook.Worksheets
    If InStr(Sheet.Name, "673") > 0 Then      

        With report
            .Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End
            (xlUp)).EntireRow.Copy
        End With

        Worksheets("Colours").Select

        lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row

        Worksheets("Colours").Cells(lastrow + 1, 1).Select
        ActiveSheet.Paste  

    End If
Next
End Sub

非常感谢您的帮助。

Answer 1

KS是对的，为了让您的代码正常运行，您只需要参考表单。我已经开始进一步修改它，所以我会发布我在整体上所做的事情：

首先，我删除了＆＃39;设置报告=＆＃39;行，不需要（或者你可以在循环开始时设置报告＆＃39;但它更容易直接工作＆＃39;使用Sheet＆＃39; as KS说。）。

CHANGED1 =你说它应该循环通过“开始”的工作表。使用673，所以这个新行检查匹配673的前三个字符，而不仅仅是查看673是否出现在工作表名称中的任何位置。

NEW =激活工作表，这使下一个复制命令有效。

CHANGED2 =使用Sheet，如上所述。

CHANGED3 =您说它应该从第5行开始复制包含数据的行（之前您的代码将复制第1-5行）。

Sub Consolidate()
    Dim lastrow As Long
    Dim report As Worksheet

    For Each Sheet In ActiveWorkbook.Worksheets
        If Left(Sheet.Name, 3) = "673" Then 'CHANGED1

            Worksheets(Sheet.Name).Select 'NEW

            With Sheet 'CHANGED2
                .Range("A5", Range("A" & 65536).End(xlUp)).EntireRow.Copy 'CHANGED3
            End With

            Worksheets("Colours").Select

            lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row

            Worksheets("Colours").Cells(lastrow + 1, 1).Select
            ActiveSheet.Paste

        End If
    Next
End Sub

希望这有帮助！

Answer 2

尝试以下代码

\n

它：

避免无用的选择和变量
仅复制非空白单元格（假设数据为＆＃34;常数＆＃34;，即不是公式）

循环工作表并粘贴代码

2 个答案: