复制偏移方法不起作用

Sub BSRange() Set ws1 = ThisWorkbook.Worksheets("Balance") Set ws2 = ThisWorkbook.Worksheets("Summary") Set ws3 = ThisWorkbook.Worksheets("Cash") Dim Lastcol As Long Dim Lastrow As Long Dim colname As String Lastcol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column For i = 2 To Lastcol With ws1 colname = Split(Cells(, i).Address, "$")(1) Lastrow = .Cells(.Rows.Count, colname).End(xlUp).Row End With With ws3 Range(Cells(4, i), Cells(Lastrow, i)).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 1) End With With ws1 Range(Cells(4, i), Cells(Lastrow, i)).Copy ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next i End Sub 

数据不会复制,编译器在代码中显示没有错误。 另外,当我试图摆脱WithFor循环中,在前缀中使用SheetName ,那么它给我一个错误。

尝试这些编辑。 我认为在跨越多个工作组时,您只需要更加小心合格的工作表。 比如Cell()会调用活动的工作表, .Cells()会调用你的With语句限定的工作簿。

 Sub BSRange() Set ws1 = ThisWorkbook.Worksheets("Balance") Set ws2 = ThisWorkbook.Worksheets("Summary") Set ws3 = ThisWorkbook.Worksheets("Cash") Dim Lastcol As Long Dim Lastrow As Long Dim colname As String Lastcol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column For i = 2 To Lastcol With ws1 colname = Split(.Cells(, i).Address, "$")(1) Lastrow = .Cells(.Rows.Count, colname).End(xlUp).Row End With With ws3 .Range(.Cells(4, i), .Cells(Lastrow, i)).Copy ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 1) End With With ws1 .Range(.Cells(4, i), .Cells(Lastrow, i)).Copy ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 0) End With Next i End Sub