Sub CopyMTHSheetsToTarget()
Dim sourceFolder As String
Dim targetFolder As String
Dim sourceFile As String
Dim targetFile As String
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim ws As Worksheet
Dim wsName As String
Dim fileCount As Integer
Dim copiedCount As Integer
Dim fso As Object
Dim folder As Object
Dim file As Object
' Set folder paths (modify according to your actual paths)
sourceFolder = "C:\SourceFolderPath\" ' Change to your source folder path
targetFolder = "C:\TargetFolderPath\" ' Change to your target folder path
' Ensure path ends with backslash
If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
If Right(targetFolder, 1) <> "\" Then targetFolder = targetFolder & "\"
' Create FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Check if source folder exists
If Not fso.FolderExists(sourceFolder) Then
MsgBox "Source folder does not exist: " & sourceFolder, vbExclamation, "Error"
Exit Sub
End If
' Check if target folder exists
If Not fso.FolderExists(targetFolder) Then
MsgBox "Target folder does not exist: " & targetFolder, vbExclamation, "Error"
Exit Sub
End If
' Get source folder
Set folder = fso.GetFolder(sourceFolder)
' Turn off screen updating and alerts to improve performance
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Loop through each file in the source folder
For Each file In folder.Files
' Check if file extension is xlsm (case-insensitive)
If LCase(fso.GetExtensionName(file.Name)) = "xlsm" Then
sourceFile = file.Name
targetFile = targetFolder & sourceFile
' Check if target file exists using FileSystemObject
If fso.FileExists(targetFile) Then
Debug.Print "Processing: " & sourceFile
' Open source file (read-only mode)
Set wbSource = Workbooks.Open(sourceFolder & sourceFile, ReadOnly:=True)
' Open target file
Set wbTarget = Workbooks.Open(targetFile)
' Iterate through all worksheets in source file
For Each ws In wbSource.Worksheets
wsName = ws.Name
' Check if worksheet name starts with "MTH" (case-insensitive)
If UCase(Left(wsName, 3)) = "MTH" Then
' Copy worksheet to target file
ws.Copy After:=wbTarget.Sheets(wbTarget.Sheets.Count)
copiedCount = copiedCount + 1
Debug.Print " Copied worksheet: " & wsName
End If
Next ws
' Save and close target file
wbTarget.Save
wbTarget.Close
' Close source file without saving
wbSource.Close SaveChanges:=False
fileCount = fileCount + 1
Debug.Print "Finished processing: " & sourceFile
Debug.Print "-----------------------------------"
Else
Debug.Print "Warning: Target file not found - " & targetFile
End If
End If
Next file
' Restore screen updating and alerts
Application.ScreenUpdating = True
Application.DisplayAlerts = True
' Display completion message
MsgBox "Processing completed!" & vbCrLf & _
"Total files processed: " & fileCount & vbCrLf & _
"Total worksheets copied: " & copiedCount & vbCrLf & _
"Check Immediate Window (Ctrl+G) for details.", _
vbInformation, "Copy Complete"
End Sub