Peter Quill
Member
- Local time
- Today, 15:34
- Joined
- Apr 13, 2023
- Messages
- 30
Private Sub TarikDataKoreksi()
Dim lr, lrow, i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Sheet_Name = "Form Faktur"
'to select folder contains workbooks
Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker)
File_Dialog.AllowMultiSelect = False
File_Dialog.Title = "Select Folder"
If File_Dialog.Show <> -1 Then
Exit Sub
End If
File_Path = File_Dialog.SelectedItems(1) & "\"
File_Name = Dir(File_Path & "*.xls*")
'to open all workbook in folder and copy the data inside to sheet Monitoring Faktur
Do While File_Name <> ""
lr = Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("A" & Rows.Count).End(xlUp).Row
lr = lr + 1
Set file = Workbooks.Open(FileName:=File_Path & File_Name)
'Nomor Faktur TanggalFaktur StatusSTNK JenisKoreksi DataAwal DataPerbaikan
file.Worksheets(Sheet_Name).Range("A4:G1000").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("A" & lr).PasteSpecial Paste:=xlPasteValues
'price
file.Worksheets(Sheet_Name).Range("U4:U1000").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("H" & lr).PasteSpecial Paste:=xlPasteValues
'no surat
file.Worksheets(Sheet_Name).Range("J1").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("J" & lr).PasteSpecial Paste:=xlPasteValues
'tgl pengajuan
file.Worksheets(Sheet_Name).Range("J2").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("I" & lr).PasteSpecial Paste:=xlPasteValues
File_Name = Dir()
Loop
end sub
Dim lr, lrow, i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Sheet_Name = "Form Faktur"
'to select folder contains workbooks
Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker)
File_Dialog.AllowMultiSelect = False
File_Dialog.Title = "Select Folder"
If File_Dialog.Show <> -1 Then
Exit Sub
End If
File_Path = File_Dialog.SelectedItems(1) & "\"
File_Name = Dir(File_Path & "*.xls*")
'to open all workbook in folder and copy the data inside to sheet Monitoring Faktur
Do While File_Name <> ""
lr = Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("A" & Rows.Count).End(xlUp).Row
lr = lr + 1
Set file = Workbooks.Open(FileName:=File_Path & File_Name)
'Nomor Faktur TanggalFaktur StatusSTNK JenisKoreksi DataAwal DataPerbaikan
file.Worksheets(Sheet_Name).Range("A4:G1000").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("A" & lr).PasteSpecial Paste:=xlPasteValues
'price
file.Worksheets(Sheet_Name).Range("U4:U1000").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("H" & lr).PasteSpecial Paste:=xlPasteValues
'no surat
file.Worksheets(Sheet_Name).Range("J1").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("J" & lr).PasteSpecial Paste:=xlPasteValues
'tgl pengajuan
file.Worksheets(Sheet_Name).Range("J2").Copy
Workbooks("Koreksi Faktur.xlsm").Worksheets("Monitoring Faktur").Range("I" & lr).PasteSpecial Paste:=xlPasteValues
File_Name = Dir()
Loop
end sub
Last edited: