2017-06-18 150 views
0

我想复制粘贴工作簿的一些列到我的活动工作簿。 我的列是分开的,所以我想通过一个循环来完成一个Collection变量。vba - 迭代集合

这里我的代码(编辑)

Option Explicit 

Sub CopyDataFromClosedWbk() 

    'copy data from closed workbook to active workbook 
    Dim colonne As Collection 
    Dim col As Variant 
    Dim xlApp As Application 
    Dim xlBook As Workbook 
    Dim Sh As Object 

    Set colonne = New Collection 

    colonne.Add "A:B", "A1" 
    colonne.Add "E:F", "G1" 
    colonne.Add "N", "I1" 
    colonne.Add "P", "F1" 


    Set xlApp = CreateObject("Excel.Application") 


    'Path source workbook 
    Set xlBook = xlApp.Workbooks.Open("C:\Users\Amira AYADI\Desktop\Stage\Automatisation\Base Case_BDD CAPACITAIRE_ENVOYE_V2 2017_2023_24042017.xlsx") 
    xlBook.Sheets("DATA").Range("A1:CJ374810").AutoFilter 
    xlBook.Sheets("DATA").Range("BD1").Select 
    xlBook.Sheets("DATA").Range("$A$1:$CJ$374810").AutoFilter Field:=56, Criteria1:="CMR" 

    For Each col In colonne 

     xlBook.Sheets("DATA").Range(col).Copy 
     xlApp.DisplayAlerts = False 
     Debug.Print col 
     Set xlBook = Nothing 
     Set xlApp = Nothing 
     Set xlBook = ActiveWorkbook 
     Set Sh = xlBook.Sheets("Calcul") 
     'Sh.Activate 
     Range(colonne.Item(col)).Select 
     Sh.paste 


    Next col 

    xlBook.Close 
    xlApp.Quit 


End Sub 

但是,这并不工作,有几个错误:

首先

Range(colonne.Item(col)).Select 

不蒙山 “关口” 工作但索引我猜。那么如何迭代Key的值呢?

其次,当我remplace COL通过1那样(为一试):

Range(colonne.Item(1)).Select 

我有一个91错误:对象变量或带块未设置。

除此之外,我还弹出一个窗口,提示工作簿“source.xlsx”已准备好进行修改。我怎么能这样呢?

你有什么想法吗?

+0

不要使用'.Select'。此外,您还在每个单元之后打开和关闭工作区,这不是非常有效。 – UGP

+0

我没注意,谢谢。 如果我不使用。选择我如何做? 我试过了Range(colnene.Item(col))。但是这并没有起作用 – blabla

+0

你需要使用Scripting.Dictionary来代替Collection,所以你可以访问键和值。 https://stackoverflow.com/questions/5702362/vba-collection-list-of-keys –

回答

0

尝试了这一点:

Option Explicit 

Sub CopyDataFromClosedWbk() 

    Dim xlApp As Application 
    Dim xlBook As Workbook 
    Dim sht As Worksheet, sht2 As Worksheet 

    Set sht2 = ThisWorkbook.Sheets("Calcul") 
    Set xlApp = CreateObject("Excel.Application") 
    Set xlBook = xlApp.Workbooks.Open("C:\Users\User\Desktop\source.xlsx") 'Adjust 
    Set sht = xlBook.Worksheets("DATA") 
    xlApp.DisplayAlerts = False 

    sht.Range("A:CJ").AutoFilter Field:=56, Criteria1:="CMR" 
    sht.Range("A:B").Copy: sht2.Range("A1").PasteSpecial xlPasteValues 
    sht.Range("E:F").Copy: sht2.Range("G1").PasteSpecial xlPasteValues 
    sht.Range("N:N").Copy: sht2.Range("I1").PasteSpecial xlPasteValues 
    sht.Range("P:P").Copy: sht2.Range("F1").PasteSpecial xlPasteValues 

    xlBook.Close 
    xlApp.Quit 
End Sub 

我不知道那里有支持使用收集/字典来保存列,但它更容易这样任何理由。

+0

谢谢!这是完美的,而且要容易得多 – blabla