insert named worksheet into other workbooks

[jono_oh]

Hello all,

I would like to run a for loop that inserts 2 worksheets ("Projects" and "Collated") into a folder's worth of other workbooks.
I have Set the worksheets that I wish to insert but ensure on how to add them to each of the workbooks.

Sub add_sheets_to_health_assessments()

'Macro Purpose:
'For each health assessment
'open the health assessment,
'add worksheets,
'save workbook,
'close workbook,

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFolderFiles As Object

Dim sFilePath As String
Dim ArchiveReportingWB_name As String

Dim ProjectsWS As Worksheet
Dim CollatedWS As Worksheet

sFilePath = Application.ActiveWorkbook.Path
ArchiveReportingWB_name = "Health Assessment Archive Reporting"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sFilePath)

'Macro Performance Optimisation Actions
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
secAutomation = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable

Workbooks.Open (sFilePath & "\" & ArchiveReportingWB_name & ".xlsm")
Windows(ArchiveReportingWB_name & ".xlsm").Activate
Sheets("Projects").Select
Set ProjectsWS = Workbooks(ArchiveReportingWB_name).Sheets("Projects")
Sheets("Collated").Select
Set CollatedWS = Workbooks(ArchiveReportingWB_name).Sheets("Collated")

For Each oFile In oFolder.Files

    If InStr(1, oFile.Name, "TSP") > 0 And InStr(1, oFile.Name, "Blank Template") = 0 Then
        Workbooks.Open (oFile)
        Windows(oFile.Name).Activate
        wSheet.Name = "Iterations"
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    End If
    
Next oFile

End Sub

 

[GWteB]

Are you saying that you want to copy those 2 worksheets to multiple other workbooks, dependent on their workbook names?
If that's the case the code below should do that.

Sub add_sheets_to_health_assessments()

    'Macro Purpose:
    'For each health assessment
    'open the health assessment,
    'add worksheets,
    'save workbook,
    'close workbook,

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object

    Dim sFilePath As String
    Dim ArchiveReportingWB_name As String

    Dim ProjectsWS As Worksheet
    Dim CollatedWS As Worksheet

    sFilePath = Application.ActiveWorkbook.Path
    ArchiveReportingWB_name = "Health Assessment Archive Reporting.xlsm"

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sFilePath)

    'Macro Performance Optimisation Actions
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim secAutomation As MsoAutomationSecurity
    secAutomation = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityForceDisable

    Dim srcWb As Workbook
    Set srcWb = Workbooks.Open(sFilePath & "\" & ArchiveReportingWB_name)

    For Each oFile In oFolder.Files
        If InStr(1, oFile.Name, "TSP") > 0 And InStr(1, oFile.Name, "Blank Template") = 0 Then
            
            Dim destWb As Workbook
            Set destWb = Workbooks.Open(oFile)
            With destWb
                srcWb.Sheets(Array("Projects", "Collated")).Copy After:=.Sheets(.Sheets.Count)
                .Save
                .Close
            End With
        End If
    Next oFile

    ' revert to normal
    Application.AutomationSecurity = secAutomation
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[jono_oh]

Are you saying that you want to copy those 2 worksheets to multiple other workbooks, dependent on their workbook names?
If that's the case the code below should do that.

Sub add_sheets_to_health_assessments()

    'Macro Purpose:
    'For each health assessment
    'open the health assessment,
    'add worksheets,
    'save workbook,
    'close workbook,

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object

    Dim sFilePath As String
    Dim ArchiveReportingWB_name As String

    Dim ProjectsWS As Worksheet
    Dim CollatedWS As Worksheet

    sFilePath = Application.ActiveWorkbook.Path
    ArchiveReportingWB_name = "Health Assessment Archive Reporting.xlsm"

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sFilePath)

    'Macro Performance Optimisation Actions
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim secAutomation As MsoAutomationSecurity
    secAutomation = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityForceDisable

    Dim srcWb As Workbook
    Set srcWb = Workbooks.Open(sFilePath & "\" & ArchiveReportingWB_name)

    For Each oFile In oFolder.Files
        If InStr(1, oFile.Name, "TSP") > 0 And InStr(1, oFile.Name, "Blank Template") = 0 Then
           
            Dim destWb As Workbook
            Set destWb = Workbooks.Open(oFile)
            With destWb
                srcWb.Sheets(Array("Projects", "Collated")).Copy After:=.Sheets(.Sheets.Count)
                .Save
                .Close
            End With
        End If
    Next oFile

    ' revert to normal
    Application.AutomationSecurity = secAutomation
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

thank you for your help in this- sorry about my delayed response, this code works for what I was after