复制并粘贴 VBA 代码 - 我想跨多个工作表使用

Question

我对 VBA 很陌生。我有一些代码可以将一个 sheet 中满足特定条件的数据复制到另一个主 sheet 中。我还有多个其他作品sheet想从中复制到母版中。请问我该如何修改我的代码才能做到这一点？

提前致谢。

Sub copyPaste()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Set ws = Sheets("S_Q")
    Set wt = Sheets("master")
    Dim i As Integer
    Dim lr As Integer
    lr = ws.Range("y" & Rows.Count).End(xlUp).Row
    Dim lt As Long

    For i = 1 To lr
    lt = wt.Range("y" & Rows.Count).End(xlUp).Row
        If ws.Range("bz" & i) > 14 Then
        ws.Range("y" & i).EntireRow.Copy wt.Range("a" & lt + 1)
        End If
    Next i
End Sub

Answer 1

无需深入了解您的代码本身的细节 - 您要运行它的所有工作表的标准是否相同？所有这些工作表中的数据布局是什么？

如果是这样，并且如果您当前的代码正在执行您需要它为工作表 A 执行的操作，而我们只需要扩展它以也处理工作表 B 到 X，那么您可以摆脱您的 dim/set ws 行，而是将第一行更改为

sub copyPaste(ws as worksheet)

这样您就可以使用单独的过程为每个需要运行的工作表调用此过程。以下是使用原始代码中的工作表的示例：

call copyPaste(ThisWorkbook.Sheets("S_Q"))

Answer 2

我会把感兴趣的 sheet 放在一个数组中循环并循环它。我还会使用 Union 来收集合格范围并一次性粘贴以提高效率。

我还会使用辅助函数来检索最后一行并将其添加到下一行。

此外，使用 Long 而不是 Integer 以避免潜在的溢出，因为 sheet 中的行数超过 Integer 可以处理的数量。

Option Explicit

Public Sub copyPaste()
    Dim ws As Worksheet, wt As Worksheet, sheetsOfInterest(), unionRng As Range
    Dim i As Long, lastRow As Long, lastRowMaster As Long
    Application.ScreenUpdating = False
    sheetsOfInterest = Array("Sheet1", "Sheet2", "S_Q")

    Set wt = ThisWorkbook.Worksheets("master")

    For Each ws In ThisWorkbook.Worksheets(sheetsOfInterest)

        lastRow = GetLastRow(ws, 25)

        For i = 1 To lastRow

            If ws.Range("BZ" & i) > 14 Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, ws.Range("bz" & i))
                Else
                    Set unionRng = ws.Range("BZ" & i)
                End If
            End If
        Next i
        If Not unionRng Is Nothing Then
            With wt
                unionRng.EntireRow.Copy .Range("A" & GetLastRow(wt, 1) + 1)
            End With
        End If
        Set unionRng = Nothing
    Next
    Application.ScreenUpdating = True
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

Answer 3

在对各种列尝试过滤器后，它在某些列上起作用，而在其他列上不起作用；没有明显的理由。我决定重新调整电子表格并将要过滤的列放在第一列中。到目前为止这似乎有效。

复制并粘贴 VBA 代码 - 我想跨多个工作表使用

Copy and paste VBA code - I want to use across multiple sheets

vba

copy

paste