Chào các tiền bối, lại là em, em có vấn đề khác cần tham khảo cao kiến của các tiền bối, vấn đề là:
em có 2 sub import_A1 và import_A8, trong 2 sub này đều có code để mở ra Brown để chọn các file Excel, khi em dùng hàm call như bên dưới thì sẽ lần lượt gọi ra sub import_A1 và import_A8 cho nên sẽ phải mở Brown ra 2 lần để chọn file (chạy sub import_A1 mở file chọn xong, thực hiện sau đó chạy sub import_A8 lại mở file chọn file và thực hiện), các tiền bối có cao kiến nào giúp e chỉ cần phải chọn file excel 1 lần không ạ?em xin cảm ơn rất nhiều!
Dưới đây là code em đã viết và check chạy bình thường, rất tiếc là đã có ảnh nên e không up thêm file Excel được:
'_____________________________________________
Option Explicit
Sub action()
Call import_A1
Call import_A8
End Sub
'_____________________________________________
Sub import_A1()
Dim EMS As Worksheet, sh As Worksheet
Dim wk As Workbook
Dim strFolderPath As String
Dim selectedFiles As Variant
Dim iFileNum As Integer
Dim strFileName As String
Dim L11 As Range, L12 As Range
getSpeed (True)
Set EMS = ActiveWorkbook.Sheets("A1")
strFolderPath = ActiveWorkbook.Path
ChDrive strFolderPath
ChDir strFolderPath
selectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
strFileName = selectedFiles(iFileNum)
Set wk = Workbooks.Open(strFileName)
For Each sh In wk.Sheets
If sh.Name Like "A1" Then
With sh
Set L11 = .Range("C5")
Set L12 = .Range("D6:BA8")
With EMS
.Range("C5") = L11.Value2
.Range("D6:BA8") = L12.Value2
End With
End With
End If
Next sh
wk.Close
Next
getSpeed (False)
MsgBox "hoan thanh update xuong A1"
End Sub
'__________________________________________
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)
Application.Calculation = IIf(doIt, xlCalculationManual, xlCalculationAutomatic)
End Function
'__________________________________________
Sub import_A8()
Dim EMS As Worksheet, sh As Worksheet, sh2 As Worksheet
Dim wk As Workbook
Dim strFolderPath As String
Dim selectedFiles As Variant
Dim iFileNum As Integer
Dim strFileName As String
Dim L11 As Range, L12 As Range
getSpeed (True)
Set EMS = ActiveWorkbook.Sheets("A8")
strFolderPath = ActiveWorkbook.Path
ChDrive strFolderPath
ChDir strFolderPath
selectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
strFileName = selectedFiles(iFileNum)
Set wk = Workbooks.Open(strFileName)
For Each sh In wk.Sheets
If sh.Name Like "A8" Then
With sh
Set L11 = .Range("C5")
Set L12 = .Range("D6:BA8")
With EMS
.Range("C5") = L11.Value2
.Range("D6:BA8") = L12.Value2
End With
End With
End If
Next sh
wk.Close
Next
getSpeed (False)
MsgBox "hoan thanh update xuong A8"
End Sub
