VBA - Copy sheets from book1 to book2 and replace if the sheet exists in book2

SDMaestro

New Member
Joined
Dec 7, 2017
Messages
10
Hi All,

Long time lurker first time poster here, relatively new to VBA. I have a workbook with a series of sheets that I would like to copy (all except the first) into a different book while also replacing any sheets with the same name in the destination workbook.

Is it possible to have a macro look at the name of the sheets in my source workbook then replace any sheets in the destination workbook if the same name exists, with any new sheets just being copied over ?

I currently have some code used to open the destination workbook, but struggle with the process above

Code:
  Sub CopyReplaceWorksheets()
Dim strDestPath As String
Dim strFileDest As String
Dim strSourcePath As String
Dim strSourceFile As String

strDestPath = Range("A1").Value
strFileDest = Range("A2").Value
strSourcePath = Range("A3").Value
strSourceFile = Range("A4").Value

info = IsWorkbookOpen(strDestPath)
If info = True Then
MsgBox "File is being used"


Else
MsgBox "File is closed"
End If


If info = False Then
Workbooks.Open strDestPath
End If

Any help or advice is much appreciated.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Hi & welcome to MrExcel
Try this
Code:
Sub CopyReplaceWorksheets()
    
    Dim DestWbk As Workbook
    Dim SrcWbk As Workbook
    Dim Ws As Worksheet
       
    Set SrcWbk = ThisWorkbook
    
    On Error Resume Next
    Set DestWbk = Workbooks("[COLOR=#ff0000]Book11.xlsm[/COLOR]")
    On Error GoTo 0
    If DestWbk Is Nothing Then
        Set DestWbk = Workbooks.Open("[COLOR=#ff0000]C:\Users\Fluff\Documents\Excel files\book11.xlsm[/COLOR]")
        If DestWbk.ReadOnly Then
            MsgBox "Destination workbook is ""ReadOnly""", vbCritical, "Read Only"
            Exit Sub
        End If
    End If
    With CreateObject("scripting.dictionary")
        For Each Ws In DestWbk.Worksheets
            .Add Ws.Name, Ws
        Next Ws

        For Each Ws In SrcWbk.Worksheets
            If Not Ws.Index = 1 Then
                Application.DisplayAlerts = False
                If .exists(Ws.Name) Then .Item(Ws.Name).Delete
                Application.DisplayAlerts = True
                Ws.copy after:=DestWbk.Sheets(Sheets.Count)
            End If
        Next Ws
    End With
            
End Sub
This needs to go in the source workbook. Change the name & file path of the destination workbook (in red) to suit.
 
Upvote 0
Hi Fluff,

Appreciate the response ! This is definitely what I'm looking for, however I am running into a run-time error 1004 on the line
Ws.copy after:=DestWbk.Sheets(Sheets.Count)
The message box indicates excel cannot insert sheets into the destination workbook since it contains fewer rows and columns than the source workbook.

There may be more or less rows of data between the sheets being transferred, is there a workaround to the error above ?
 
Upvote 0
Is the source book an .xlsm & the destination an .xls?
 
Upvote 0
It was set up like that but I have since changed both to .xlsm and it appears to be working like a charm.

Thank you very much !
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0
Hi there,
how can use the above code and to avoid at the same time to receive #REF issue at other worksheet formulas ??? (probably due to worksheet deletion..)
 
Upvote 0
@GeoBa
Please start a new thread for your question. Thanks
 
Upvote 0

Forum statistics

Threads
1,213,496
Messages
6,113,993
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top