在下拉select后无法打开匹配的工作簿

初步问题

为什么我无法打开所有（全部三个）匹配的工作簿？

下拉select：

1A：1C =公司1公司2公司3

2A：2C =版本2版本1版本1

只有第一个（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的想法（见下文），并且我试图按顺序打开5个（或更less）工作簿，每次将特定范围复制/粘贴到“main”工作簿的“main2”表中。

它工作正常，除非我打开更less的工作簿比正在检查的下拉值的数量（我目前使用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 （在打开第一个工作簿后，您的所有Cells将引用它而不是原始来源）