Option Explicit
Private Const ROOT_FOLDER As String = "C:\Users\asus\Desktop\excel\"
Private Sub CommandButton1_Click()
Dim i As Long
Dim blatt As Long
Dim objWorbook As Workbook
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
blatt = 0
For i = 1 To 6
If Me.Controls("OptionButton" & i).Value = True Then blatt = i
Next i
If blatt = 0 Then End
For i = 1 To 6
If Me.Controls("ComboBox" & i).ListIndex > -1 Then
Set objWorbook = Workbooks.Open(Filename:=ROOT_FOLDER & Me.Controls("ComboBox" & i).Text, UpdateLinks:=0, ReadOnly:=True)
objWorbook.Worksheets(blatt).Range("A3:F3").Copy ThisWorkbook.Worksheets(1).Cells(3 + i, 1)
objWorbook.Close SaveChanges:=False
Set objWorbook = Nothing
End If
Next i
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Private Sub CommandButton2_Click()
Call Unload(Me)
End Sub
Private Sub UserForm_Initialize()
Dim strFilename As String
strFilename = Dir(ROOT_FOLDER & "*.xls")
Do Until strFilename = vbNullString
Call ComboBox1.AddItem(pvargItem:=strFilename)
Call ComboBox2.AddItem(pvargItem:=strFilename)
Call ComboBox3.AddItem(pvargItem:=strFilename)
Call ComboBox4.AddItem(pvargItem:=strFilename)
Call ComboBox5.AddItem(pvargItem:=strFilename)
Call ComboBox6.AddItem(pvargItem:=strFilename)
strFilename = Dir
Loop
End Sub