Open Files (1 Viewer)

Peter Quill

Member
Local time
Today, 17:47
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
 
Last edited:

CJ_London

Super Moderator
Staff member
Local time
Today, 12:47
Joined
Feb 19, 2013
Messages
16,616
please use code tags to around your code to preserve indentation.

The method I use is to use autofilter to filter the rows then take whatever action is required - use a macro builder to get what you want but as an example it might look something like this (copied from one of my apps)

Code:
with ws
     .UsedRange.AutoFilter Field:=5, Criteria1:="=Closing Balance"
     Set r = .Range(.cells(2, 1), .cells(.UsedRange.Rows.Count, i))
end with

ws is the worksheet object
UsedRange is the range occupied with data (I.e. A1 to bottom right)
field is the column number (need to be 1 in your case for column A).
criteria speaks for itself - in my case I want to find all the closing balance rows to format the row with font weights, lines etc. In your case it would be something like "=blank" - but you will need to check

Using your macro builder find the code to delete the blank rows.

In my case I set a range as above, you may need to or not
 

Pat Hartman

Super Moderator
Staff member
Local time
Today, 07:47
Joined
Feb 19, 2002
Messages
43,293
An alternative which does not require opening and updating the spreadsheet is to link to the spreadsheet and then use an append query which selects all the rows where ColumnA is not null.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 12:47
Joined
Feb 19, 2013
Messages
16,616
@Pat Hartman - OP is copying from one excel file to another, not into Access. I'll move the thread to the excel forum
 

Users who are viewing this thread

Top Bottom