Vba 下拉选择后无法打开匹配的工作簿

初始问题

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

下拉选择：

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

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）

多谢各位

后续行动

@德克·雷切尔： @全部：

我试着扩展一下德克的想法（见下文），每次将特定范围复制/粘贴到“main”工作簿的“main2”工作表时，我都会按顺序打开5本（或更少）工作簿

除非我打开的工作簿少于正在检查的下拉列表值的数量（我目前使用的是5个下拉列表集，而不是原来的3个：请参见页首），否则它可以正常工作：

子导入数据（）
将工作簿设置为工作簿
将数据工作簿设置为工作簿
我想我会坚持多久
设置Main工作簿=此工作簿
使用MainWorkbook.ActiveSheet
对于i=2到6
如果ActiveSheet.Cells（6，i）.Value为“”，则
设置DataWorkbook=Workbooks.Open（“D:\'一些文件夹'\”&.Cells（6，
i） .Value和“-”和.Cells（10,2）和“-”和.Cells（7,i）.Value和“.xlsx”）
数据工作簿.工作表（“Sheet1”）.范围（“C3:Q3”）.副本
MainWorkbook.Sheets（“Main2”）.范围（“A”和“i”）.粘贴特殊
出错时继续下一步
如果结束
接下来我
以
端接头

---

我使用了（现在）5个下拉菜单中的3个，目前只有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

---

如果您的

单元格

没有任何“工作簿”和“工作表”，它们将使用活动工作簿（打开第一个工作簿后，您的所有

单元格

都将引用它，而不是原始来源）

多美的答案@Dirk Reichel。这是一个很好的例子，可以在代码中寻找共同点，并使用它们来消除多余的内容，使其完全干燥。@Dirk Reichel:非常高效和简洁！非常感谢。赫兹利什·格鲁（不，我不是德国人）只需将

If-ActiveSheet.Cells（6，i）.V….

更改为

If.Cells（6，i）.V….

。。。这应该可以奏效；）@德克·雷切尔：我会试试看。。。再次感谢。干杯！@德克·雷切尔：@All:我在下一个问题中发布了一个“跟进”：。

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