複製偏移方法不起作用

Question

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 

數據不會複製，編譯器在代碼中顯示沒有錯誤。另外，當我試圖擺脫For循環中的With，在前綴中使用SheetName，那麼它會給我一個錯誤。

Answer 1

嘗試進行這些編輯。我認爲在跨越多個工作組時，您只需要更加小心合格的工作表。比如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