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

数据不会复制，编译器在代码中没有显示错误。此外，当我尝试在With循环中删除For时，在前缀中使用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

复制偏移方法不起作用

1 个答案: