Option Explicit
Private Const ROOT_FOLDER As String = "C:\Users\asus\Desktop\excel\"
Private Sub CommandButton1_Click()
Dim objWorbook As Workbook
If ComboBox1.ListIndex > -1 Then
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objWorbook = Workbooks.Open(Filename:= _
ROOT_FOLDER & ComboBox1.Text, UpdateLinks:=0, ReadOnly:=True)
Call objWorbook.Worksheets(1).Range("A3:F3").Copy( _
Destination:=ThisWorkbook.Worksheets(1).Cells(4, 1))
Call objWorbook.Close(SaveChanges:=False)
Set objWorbook = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End If
If ComboBox2.ListIndex > -1 Then
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objWorbook = Workbooks.Open(Filename:= _
ROOT_FOLDER & ComboBox2.Text, UpdateLinks:=0, ReadOnly:=True)
Call objWorbook.Worksheets(1).Range("A3:F3").Copy( _
Destination:=ThisWorkbook.Worksheets(1).Cells(5, 1))
Call objWorbook.Close(SaveChanges:=False)
Set objWorbook = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End If
If ComboBox3.ListIndex > -1 Then
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objWorbook = Workbooks.Open(Filename:= _
ROOT_FOLDER & ComboBox3.Text, UpdateLinks:=0, ReadOnly:=True)
Call objWorbook.Worksheets(1).Range("A3:F3").Copy( _
Destination:=ThisWorkbook.Worksheets(1).Cells(6, 1))
Call objWorbook.Close(SaveChanges:=False)
Set objWorbook = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End If
If ComboBox4.ListIndex > -1 Then
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objWorbook = Workbooks.Open(Filename:= _
ROOT_FOLDER & ComboBox4.Text, UpdateLinks:=0, ReadOnly:=True)
Call objWorbook.Worksheets(1).Range("A3:F3").Copy( _
Destination:=ThisWorkbook.Worksheets(1).Cells(7, 1))
Call objWorbook.Close(SaveChanges:=False)
Set objWorbook = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End If
If ComboBox5.ListIndex > -1 Then
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objWorbook = Workbooks.Open(Filename:= _
ROOT_FOLDER & ComboBox5.Text, UpdateLinks:=0, ReadOnly:=True)
Call objWorbook.Worksheets(1).Range("A3:F3").Copy( _
Destination:=ThisWorkbook.Worksheets(1).Cells(8, 1))
Call objWorbook.Close(SaveChanges:=False)
Set objWorbook = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End If
If ComboBox6.ListIndex > -1 Then
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objWorbook = Workbooks.Open(Filename:= _
ROOT_FOLDER & ComboBox6.Text, UpdateLinks:=0, ReadOnly:=True)
Call objWorbook.Worksheets(1).Range("A3:F3").Copy( _
Destination:=ThisWorkbook.Worksheets(1).Cells(9, 1))
Call objWorbook.Close(SaveChanges:=False)
Set objWorbook = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub
Private Sub CommandButton2_Click()
Call Unload(Me)
End Sub
Private Sub UserForm_Activate()
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