Hi
after search in the internet I got code to import multiple sheets across files, but I see this code too big , I'm not sure if there is way to make short.
anyway I have multiple files and Master file in the same folder("C:\Users\AMR\Desktop\EXCEL"
what I want macro to show all of sheets from all of files to MASTER file before HOME sheet. every time run the macro should replace data for all of sheets have already added in MASTER file without add sheets every time when run the macro.
if the the same sheet name is repeated for some files then should show message box " there is duplicates sheets names in file name..."
the message box should show file name are repeated the same sheets names .
if I click OK then should add number 1,2,3 (EX: MAIN sheet is existed in some files then will be MAIN, MAIN1,MAIN2) . if I click no then should just show MAIN and ignore the others .
the code deos
1-It will iterate through all the Excel files in the specified folder.
2-It will copy all the sheets from these files into the Master file before the "HOME" sheet.
3-It will replace the data for sheets that have already been added.
4-It will check for duplicate sheet names and show a message box if duplicates are found.
-If you click "OK", it will add numbers to the duplicate sheet names. If you click "No", it will ignore the duplicates.
as you see the code is too long and shows application defined error in this line
response = MsgBox("There are duplicate sheet names in the following files: " & vbCrLf & Join(Application.Transpose(duplicateFiles), vbCrLf) & vbCrLf & "Click OK to rename duplicates, or No to ignore them.", vbOKCancel + vbExclamation, "Duplicate Sheet Names")
Sub CopySheetsToMaster()
Dim folderPath As String
Dim masterWorkbook As Workbook
Dim fileWorkbook As Workbook
Dim fileName As String
Dim sheet As Worksheet
Dim masterSheet As Worksheet
Dim homeSheetIndex As Integer
Dim sheetNames As Collection
Dim duplicateSheetNames As Collection
Dim duplicateFiles As Collection
Dim response As VbMsgBoxResult
Dim i As Integer
' Set the folder path
folderPath = "C:\Users\AMR\Desktop\EXCEL\"
' Set the master workbook
Set masterWorkbook = ThisWorkbook
' Find the index of the HOME sheet
homeSheetIndex = masterWorkbook.Worksheets("HOME").Index
' Initialize collections
Set sheetNames = New Collection
Set duplicateSheetNames = New Collection
Set duplicateFiles = New Collection
' Loop through all Excel files in the folder
fileName = Dir(folderPath & "*.xls*")
Do While fileName <> ""
Set fileWorkbook = Workbooks.Open(folderPath & fileName)
' Loop through all sheets in the file
For Each sheet In fileWorkbook.Worksheets
On Error Resume Next
sheetNames.Add sheet.Name, sheet.Name
If Err.Number <> 0 Then
' Duplicate sheet name found
duplicateSheetNames.Add sheet.Name
duplicateFiles.Add fileName
Err.Clear
End If
On Error GoTo 0
Next sheet
fileWorkbook.Close False
fileName = Dir
Loop
' Check for duplicate sheet names
If duplicateSheetNames.Count > 0 Then
response = MsgBox("There are duplicate sheet names in the following files: " & vbCrLf & Join(Application.Transpose(duplicateFiles), vbCrLf) & vbCrLf & "Click OK to rename duplicates, or No to ignore them.", vbOKCancel + vbExclamation, "Duplicate Sheet Names")
If response = vbCancel Then Exit Sub
End If
' Clear existing sheets before HOME sheet
For i = 1 To homeSheetIndex - 1
masterWorkbook.Worksheets(1).Delete
Next i
' Loop through all Excel files in the folder again to copy sheets
fileName = Dir(folderPath & "*.xls*")
Do While fileName <> ""
Set fileWorkbook = Workbooks.Open(folderPath & fileName)
' Loop through all sheets in the file
For Each sheet In fileWorkbook.Worksheets
On Error Resume Next
sheet.Copy Before:=masterWorkbook.Worksheets("HOME")
If Err.Number <> 0 Then
' Duplicate sheet name found
If response = vbOK Then
sheet.Copy Before:=masterWorkbook.Worksheets("HOME")
masterWorkbook.Worksheets(sheet.Name).Name = sheet.Name & sheetNames.Count
End If
Err.Clear
End If
On Error GoTo 0
Next sheet
fileWorkbook.Close False
fileName = Dir
Loop
End Sub
so I hope to make short and does based on my requirements.