复制列问题

liuweistat

我想把原始表里的列复制到复制表里的列，请老师帮我解决，并且运行好是按复制表里的顺序排列       
       
       
       
       
       
       
       
       

TomingTang

1. Sub 复制列()
   
2. Dim Arr, Brr(), drow%, i%
   
3. Arr = Worksheets("原始表").Range("a1").CurrentRegion
   
4. With Worksheets("复制表")
   
5.     ReDim Brr(1 To UBound(Arr), 1 To 3)
   
6.     For i = 2 To UBound(Arr)
   
7.         Brr(i - 1, 1) = Arr(i, 3): Brr(i - 1, 2) = Arr(i, 1): Brr(i - 1, 3) = Arr(i, 4)
   
8.     Next
   
9.     .Range("a2:c65536").ClearContents
   
10.     .Range("a2").Resize(UBound(Arr) - 1, 3) = Brr
    
11. End With
    
12. End Sub
    

复制代码

TomingTang

请查看附件

liuweistat

TomingTang 发表于 2015-6-3 11:54
请查看附件

请问下如果这里原始表是另外一个文件，在复制表中通过输入原始表的路径来做出这种效果，应该怎么操作

TomingTang

1. Sub 复制列()
   
2.     Dim Arr, Brr(), drow%, i%, wb As Workbook, sht As Worksheet
   
3.     Set wb = GetObject(Worksheets("原始表路径").Range("b1") & "\原始表.xlsx")
   
4.     Set sht = wb.Worksheets("原始表")
   
5.     Arr = sht.Range("a1").CurrentRegion
   
6.     With Worksheets("复制表")
   
7.         ReDim Brr(1 To UBound(Arr), 1 To 3)
   
8.         For i = 2 To UBound(Arr)
   
9.             Brr(i - 1, 1) = Arr(i, 3): Brr(i - 1, 2) = Arr(i, 1): Brr(i - 1, 3) = Arr(i, 4)
   
10.         Next
    
11.         .Range("a2:c65536").ClearContents
    
12.         .Range("a2").Resize(UBound(Arr) - 1, 3) = Brr
    
13.     End With
    
14. End Sub
    

复制代码

TomingTang

请查看附件