2015-04-01 47 views
0
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,那么它会给我一个错误。复制偏移方法不起作用

回答

2

尝试进行这些编辑。我认为在跨越多个工作组时,您只需要更加小心合格的工作表。比如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