我从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
答案 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