VBA

[mkral]

Hi, I want to move 2 worksheets from one workbook to opened 10 other workbooks with one click, is there any solution?


EDIT:
I want to replace two old sheets (has same name as new sheets). Now I delete in every workbooks two sheets and then for each workbook copy two new sheets.

### Copy selected sheets to all opened workbooks###

 

[coulombevin]

Hi mkral,

Sorry for the delay, i didn't saw your request before. Here's a vba code that will do the trick:

Sub replaceSheet()
    Dim wb1 As ThisWorkbook
    Dim wb2 As Workbook
    Dim ws As Worksheet
    Dim sheetName1 As String, sheetName2 As String
    Dim sheetExist1 As Boolean, sheetExist2 As Boolean, tempSheet As Boolean
    
    sheetName1 = "Feuil1"
    sheetName2 = "Feuil2"
    
    sheetExist1 = False
    sheetExist2 = False
    
    Set wb1 = ThisWorkbook
    
    For Each ws In wb1.Worksheets
        If ws.Name = sheetName1 Then
            sheetExist1 = True
        End If
        If ws.Name = sheetName2 Then
            sheetExist2 = True
        End If
    Next ws
    
    For Each wb2 In Workbooks
        If wb2.Name <> wb1.Name Then
            tempSheet = False
            For Each ws In wb2.Worksheets
                If sheetExist1 And ws.Name = sheetName1 Then
                    If wb2.Worksheets.Count = 1 And Not tempSheet Then
                        ws.Name = "TEMP_SHEET_TO_REMOVE"
                        tempSheet = True
                    Else
                        Application.DisplayAlerts = False
                        ws.Delete
                        Application.DisplayAlerts = True
                    End If
                End If
                If sheetExist2 And ws.Name = sheetName2 Then
                    If wb2.Worksheets.Count = 1 And Not tempSheet Then
                        ws.Name = "TEMP_SHEET_TO_REMOVE"
                        tempSheet = True
                    Else
                        Application.DisplayAlerts = False
                        ws.Delete
                        Application.DisplayAlerts = True
                    End If
                End If
            Next ws
        
            If sheetExist1 Then
                wb1.Sheets(sheetName1).Copy After:=wb2.Sheets(wb2.Sheets.Count)
            End If
            If sheetExist2 Then
                wb1.Sheets(sheetName2).Copy After:=wb2.Sheets(wb2.Sheets.Count)
            End If
            If tempSheet Then
                Application.DisplayAlerts = False
                wb2.Sheets("TEMP_SHEET_TO_REMOVE").Delete
                Application.DisplayAlerts = True
            End If
        End If
    Next wb2
End Sub

Bests regards,

Vincent

 

[mkral]

Hi, Thank you very much!! I am not very familiar with coding. Could you advise what I should change in the code?

my sheets are named: A, B. So I changed the below part of the code. Macro does not work still...

sheetName1 = "A"
sheetName2 = "B"



Also, I need to copy two worksheets together as I have there formulas

 

[coulombevin]

Hi @mkral ,

Sub replaceSheet()
    Dim wb1 As ThisWorkbook
    Dim wb2 As Workbook
    Dim ws As Worksheet
    Dim sheetName1 As String, sheetName2 As String
    Dim sheetExist1 As Boolean, sheetExist2 As Boolean, tempSheet As Boolean
    
    'Names of sheets present in all opened workbook
    sheetName1 = "A"
    sheetName2 = "B"
    
    'Preset existing as false for loop
    sheetExist1 = False
    sheetExist2 = False
    'Set the workbook that launch this macro as the one that will copy both sheets in other workbooks
    Set wb1 = ThisWorkbook
    'Before copy, check if those sheets exist for real
    For Each ws In wb1.Worksheets
        If ws.Name = sheetName1 Then
            sheetExist1 = True
        End If
        If ws.Name = sheetName2 Then
            sheetExist2 = True
        End If
    Next ws
    'Loop each opened workbooks
    For Each wb2 In Workbooks
        'If the looped workbook is not the one running this marcro then
        If wb2.Name <> wb1.Name Then
            tempSheet = False
            'loop each sheets of that workbook
            For Each ws In wb2.Worksheets
                'If the looped sheet has the same name as sheet one and sheet one exist in the master workbook then
                If sheetExist1 And ws.Name = sheetName1 Then
                    'if there is only one sheet then prevent error by renaming sheet
                    If wb2.Worksheets.Count = 1 And Not tempSheet Then
                        ws.Name = "TEMP_SHEET_TO_REMOVE"
                        tempSheet = True
                    Else
                    'if not the only sheet delete it
                        Application.DisplayAlerts = False
                        ws.Delete
                        Application.DisplayAlerts = True
                    End If
                End If
                'If the looped sheet has the same name as sheet two and sheet two exist in the master workbook then
                If sheetExist2 And ws.Name = sheetName2 Then
                    'if there is only one sheet then prevent error by renaming sheet
                    If wb2.Worksheets.Count = 1 And Not tempSheet Then
                        ws.Name = "TEMP_SHEET_TO_REMOVE"
                        tempSheet = True
                    Else
                    'if not the only sheet delete it
                        Application.DisplayAlerts = False
                        ws.Delete
                        Application.DisplayAlerts = True
                    End If
                End If
            'loop next sheet
            Next ws
            'if sheet one exist in master workbook then copy to the looped workbook
            If sheetExist1 Then
                wb1.Sheets(sheetName1).Copy After:=wb2.Sheets(wb2.Sheets.Count)
            End If
            'if sheet two exist in master workbook then copy to the looped workbook
            If sheetExist2 Then
                wb1.Sheets(sheetName2).Copy After:=wb2.Sheets(wb2.Sheets.Count)
            End If
            'if sheet has been renamed the remove the renamed temporary sheet
            If tempSheet Then
                Application.DisplayAlerts = False
                wb2.Sheets("TEMP_SHEET_TO_REMOVE").Delete
                Application.DisplayAlerts = True
            End If
        End If
    'loop next wb
    Next wb2
End Sub

Here's the code with sheet names changed as A and B and comment added. You must put that in VBA module of the workbook that you want to copy the sheet to other workbook.

How does it work:
All opened workbook that contain sheets with name A and B except the one that run the macro (master workbook), will get their sheets A and B deleted then replaced with the sheets A and B from the master workbook.

If there is an error, please provide the yellow highlited line of vba.

Bests regards,

Vincent