将合并数据从多个工作表复制到.ActiveWorksheet

时间:2018-10-03 17:09:30

标签: excel vba excel-vba

我从this的文章开始尝试将来自多个工作表的数据合并到一个摘要工作表中。我几乎可以正常工作,但是我正在努力更改目标工作表。

我正在尝试将合并的数据显示在B4工作表的单元格Consolidated Tracker中。

 With CopyRng

         Set DestSh = ThisWorkbook.Worksheets("Consolidated Tracker")
         Set myRange = DestSh.Range("B4")

 End With

问题是myRange始终为空,不会复制任何内容。

没有错误,似乎可以按预期执行f8而不复制任何内容。


完整代码供参考:

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

ExitTheSub:

    Application.Goto DestSh.Cells(4, 2)

    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit

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

1 个答案:

答案 0 :(得分:1)

问题在于,代码从不实际执行任何类型的命令来移动数据。该代码仅设置变量。

请查看下面的修改后的代码,尤其是“结尾为”之前的最后一行。

' 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")
    DestSh.Range("B4").Resize(CopyRng.Rows.Count,1).Value = CopyRng.Value
End With