复制多张

Question

如何从多张纸张而不仅仅是Sheet1中获取数据？

 Sub CheckRowsWithAutofilter()

    Dim DataBlock As Range, Dest As Range
    Dim LastRow As Long, LastCol As Long
    Dim SheetOne As Worksheet, SheetTwo As Worksheet

    'set references up-front
    Set SheetOne = ThisWorkbook.Worksheets("Sheet1")
    Set SheetTwo = ThisWorkbook.Worksheets("Sheet2")
    Set Dest = SheetTwo.Cells(Last + 1, "A") 

    'enter code here
    'identify the "data block" range, which is where
    With SheetOne
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set DataBlock = .Range(.Cells(112, 7), .Cells(LastRow, LastCol))
    End With

    With DataBlock
        .SpecialCells(xlCellTypeVisible).Copy Destination:=Dest
    End With

End Sub

Answer 1

这应循环遍历vWSs变量数组中命名的每个工作表。

Sub CheckRowsWithAutofilter()

    Dim lr As Long, lc As Long
    Dim SheetTwo As Worksheet
    Dim w As Long, vWSs As Variant

    'set references up-front
    vWSs = Array("Sheet1", "Sheet3", "Sheet4")
    Set SheetTwo = ThisWorkbook.Worksheets("Sheet2")

    'loop through the worksheets named in vWSs
    For w = LBound(vWSs) To UBound(vWSs)
        With Worksheets(vWSs(w))
            lr = .Range("A" & .Rows.Count).End(xlUp).Row
            lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
            With .Range(.Cells(112, 7), .Cells(lr, lc))
                .SpecialCells(xlCellTypeVisible).Copy _
                    Destination:=Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            End With
        End With
    Next w

End Sub

我删除了一些变量，因为它们仅使用一次，有时声明和分配它们的代码不仅仅是直接引用。