Question

从B4的单元格SheetA开始，我试图从所有其他工作表的单元格B4:B50复制并粘贴值。

它应该看起来像这样：

 ColumnB
 Sheet2 Data
 Sheet2 Data
 Sheet2 Data
 Sheet3 Data
 Sheet3 Data
 Sheet4 Data
 Sheet4 Data

通常，我认为以下代码中的所有内容都可以正常粘贴，而接下来的操作我有些茫然。

我正在使用这些功能来建立LastRow和LastCol

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

Sub CopyRangeFromMultiWorksheets()

    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets

            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)

            ' Specify the range to place the data.
            Set CopyRng = sh.Range("B4:B50")

            ' This statement copies values
            With CopyRng
                 Set DestSh = ThisWorkbook.Worksheets("Consolidated Tracker")
                 Set myRange = DestSh.Range("B4")
           End With

        'End If
    Next

End Sub

Answer 1

稍微不确定一下，因为不确定您的函数返回什么，但是请尝试此操作。顺便说一下，activeworkbook和thisworkbook不一定相同（后者是包含代码的代码，可能未激活）。

最后重新启动。

Sub CopyRangeFromMultiWorksheets()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set DestSh = ThisWorkbook.Worksheets("Consolidated Tracker")

For Each sh In ActiveWorkbook.Worksheets 'activeworkbook or thisworkbook?
    If sh.Name <> DestSh.Name Then
        Last = WorksheetFunction.Max(4, DestSh.Range("B" & Rows.Count).End(xlUp).Row)
        sh.Range("B4:B50").Copy DestSh.Range("B" & Last)
    End If
Next

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

Answer 2

我认为您正在寻找类似的东西

sh.Range("B4:B50").Copy Destination:=ThisWorkbook.Worksheets("Consolidated Tracker").Range("B4")

或可能

Set CopyRng = sh.Range("B4:B50")
Set DestRng = ThisWorkbook.Worksheets("Consolidated Tracker").Range("B4:B50")

CopyRng.Copy Destination:=DestRng

Documentation on the copy function can be found at Microsoft's webpages。

如果只需要原始范围内的值，可以将目标范围设置为等于它们

Set CopyRng = sh.Range("B4:B50")
Set DestRng = ThisWorkbook.Worksheets("Consolidated Tracker").Range("B4:B50")

DestRng.Value = CopyRng.Value

Answer 3

保持简单。

Sub Button1_Click()
    Dim sh As Worksheet, ws As Worksheet

    Set ws = Sheets("Consolidated Tracker")


    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                .Range("B4:B50").Copy ws.Range("A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1)
            End With
        End If
    Next sh

End Sub

设置myRange不设置任何内容

3 个答案: