Hi need help in vba code for complied the data of all excel files which is available in folder , there 3 tab in each sheet, I want to compiled only details tab data except header.
in two condition files name and files count will change every month,
I have done but when copy the data there missing some row after copy paste.
Sub CopyData()
Windows("Time Entry Compliance Report Japan (JPN15) Template.xlsx").Activate
Application.ScreenUpdating = False
Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
Set desWS = ActiveWorkbook.Sheets("Data")
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
FolderName = .SelectedItems(1) & "\"
End With
ChDir FolderName
strExtension = Dir("*.xlsx")
Do While strExtension <> ""
Set srcWB = Workbooks.Open(FolderName & strExtension)
With srcWB.Sheets("Details")
.Rows(2).Copy desWS.Cells(1, 1)
LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.UsedRange.Offset(2, 0).Cells.Copy desWS.Cells(LastRow + 1, 1)
End With
srcWB.Close False
strExtension = Dir
Loop
Application.ScreenUpdating = True
in two condition files name and files count will change every month,
I have done but when copy the data there missing some row after copy paste.
Sub CopyData()
Windows("Time Entry Compliance Report Japan (JPN15) Template.xlsx").Activate
Application.ScreenUpdating = False
Dim desWS As Worksheet, srcWB As Workbook, LastRow As Long
Set desWS = ActiveWorkbook.Sheets("Data")
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
FolderName = .SelectedItems(1) & "\"
End With
ChDir FolderName
strExtension = Dir("*.xlsx")
Do While strExtension <> ""
Set srcWB = Workbooks.Open(FolderName & strExtension)
With srcWB.Sheets("Details")
.Rows(2).Copy desWS.Cells(1, 1)
LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.UsedRange.Offset(2, 0).Cells.Copy desWS.Cells(LastRow + 1, 1)
End With
srcWB.Close False
strExtension = Dir
Loop
Application.ScreenUpdating = True