2017-06-18 159 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