Hi experts ,
here is code will pull all of data from all of files are existed in the same folder for sheet name is MATCH , so if there files don't contain MATCH sheet then will shows error subscript out of range in this line
so what I want show message box" the sheet is not existed, do you want rename all of sheets in all closed file to MATCH sheet" and contains two choices if press ok , then will rename to MATCH sheet and pull data , if I press no , then will just pull data for just files contains MATCH sheet without rename MATCH sheet for files don't contain MATCH sheet .
last thing when rename sheet to MATCH sheet for closed files should search for the first sheet to rename to MATCH sheet and ignore the others files contain MATCH sheet .
here is code will pull all of data from all of files are existed in the same folder for sheet name is MATCH , so if there files don't contain MATCH sheet then will shows error subscript out of range in this line
VBA Code:
With .Sheets("MATCH")
so what I want show message box" the sheet is not existed, do you want rename all of sheets in all closed file to MATCH sheet" and contains two choices if press ok , then will rename to MATCH sheet and pull data , if I press no , then will just pull data for just files contains MATCH sheet without rename MATCH sheet for files don't contain MATCH sheet .
last thing when rename sheet to MATCH sheet for closed files should search for the first sheet to rename to MATCH sheet and ignore the others files contain MATCH sheet .
VBA Code:
Sub CopyRangeFromSetFolder()
Dim desWS As Worksheet, wb As Workbook, lRow As Long
Dim wbNm As String, Fld As String
Application.ScreenUpdating = False
Set desWS = ThisWorkbook.Sheets("Sheet1")
desWS.Range("A2").CurrentRegion.Offset(1, 0).ClearContents
' define path to set folder, ending in \
Fld = ThisWorkbook.Path & "\"
'get first file with wildcard match
wbNm = Dir(Fld & "*.xls*", vbNormal)
' loop while there's another matching file
Do While wbNm <> ""
' Check it's not this workbook
If wbNm <> ThisWorkbook.Name Then
With GetObject(Fld & wbNm)
With .Sheets("MATCH")
lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("A2:D" & lRow).Copy
desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
' close the file without saving
Application.DisplayAlerts = False
.Close False
Application.DisplayAlerts = True
End With
Else
MsgBox "File Elmarghanie Brand .xlsm not found"
Exit Sub
End If
' get next matching file
wbNm = Dir()
Loop
Application.ScreenUpdating = True
End Sub