下拉選擇后無法打開匹配的工作簿

Question

初步問題

為什么我無法打開所有（全部三個）匹配的工作簿？

下拉選擇：

1A：1C = Company1 Company2 Company3

2A：2C = Version2 Version1 Version1

只有第一個（Company1，Version2）才會打開......

Sub OpenWorkbooks()

Dim ColumnIndex1 As Integer
Dim ColumnIndex2 As Integer
Dim ColumnIndex3 As Integer
Dim ColumnIndex4 As Integer
Dim ColumnIndex5 As Integer
Dim ColumnIndex6 As Integer

For ColumnIndex1 = 1 To 3
If Cells(1, ColumnIndex1).Value = "Company1" And Cells(2,      
ColumnIndex1).Value = "Version1" Then
Workbooks.Open Filename:="D:\Company1\Version1.xlsx"
End If
Next ColumnIndex1

For ColumnIndex2 = 1 To 3
If Cells(1, ColumnIndex2).Value = "Company1" And Cells(2,
ColumnIndex2).Value = "Version2" Then
Workbooks.Open Filename:="D:\Company1\Version2.xlsx"
End If
Next ColumnIndex2

For ColumnIndex3 = 1 To 3
If Cells(1, ColumnIndex3).Value = "Company2" And Cells(2,
ColumnIndex3).Value = "Version1" Then
Workbooks.Open Filename:="D:\Company2\Version1.xlsx"
End If
Next ColumnIndex3

For ColumnIndex4 = 1 To 3
If Cells(1, ColumnIndex4).Value = "Company2" And Cells(2, 
ColumnIndex4).Value = "Version2" Then
Workbooks.Open Filename:="D:\Company2\Version2.xlsx"
End If
Next ColumnIndex4

For ColumnIndex5 = 1 To 3
If Cells(1, ColumnIndex5).Value = "Company3" And Cells(2, 
ColumnIndex5).Value = "Version1" Then
Workbooks.Open Filename:="D:\Company3\Version1.xlsx"
End If
Next ColumnIndex5

For ColumnIndex6 = 1 To 3
If Cells(1, ColumnIndex6).Value = "Company3" And Cells(2, 
ColumnIndex6).Value = "Version2" Then
Workbooks.Open Filename:="D:\Company3\Version2.xlsx"
End If
Next ColumnIndex6

End Sub

我剛開始使用VBA（和StackOverflow）。

謝謝。

跟進

@ Dirk Reichel：@全部：

我試圖稍微擴展Dirk的想法（見下文），並且每次將特定范圍復制/粘貼到“main”工作簿的“main2”表時，我試圖按順序打開5個（或更少）工作簿。

它工作正常，除非我打開的工作簿少於正在檢查的下拉值的數量（我目前使用5個下拉集而不是原始3：請參閱頁面頂部）：

Sub ImportData()

Dim MainWorkbook As Workbook
Dim DataWorkbook As Workbook
Dim i As Long

Set MainWorkbook = ThisWorkbook

With MainWorkbook.ActiveSheet

For i = 2 To 6

If ActiveSheet.Cells(6, i).Value <> "" Then

Set DataWorkbook = Workbooks.Open("D:\ 'some folders' \" & .Cells(6, 
i).Value & "-" & .Cells(10, 2) & "-" & .Cells(7, i).Value & ".xlsx")
DataWorkbook.Sheets("Sheet1").Range("C3:Q3").Copy
MainWorkbook.Sheets("Main2").Range("A" & i).PasteSpecial

On Error Resume Next

End If

Next i

End With

End Sub

我使用了3個（現在的）5個下拉菜單，目前只有1個工作簿正在打開並復制...

Answer 1

您可以嘗試這樣一個更簡單的腳本：

Sub OpenWorkbooks()
  Dim i As Long
  With ThisWorkbook.ActiveSheet
    For i = 1 To 3
      Workbooks.Open Filename:="D:\" & .Cells(1, i).Value & "\" & .Cells(2, i).Value & ".xlsx"
    Next i
  End With
End Sub

如果您的Cells沒有任何“工作簿”和“工作表”，他們將使用活動單元（在打開第一個工作簿之后，所有Cells將引用它而不是原始源）