Copy Values from Worksheets in a different Workbook to Existing Worksheets

Question

I need to copy data from the (origin) Workbook to the (destination) Workbook with pre-built existing worksheets in the destination Workbook. I need the code to loop through the worksheets in the origin file and copy and paste values to the specified worksheets in the destination. There are around 100+ sheets that will need this to be done for.

I found this code online and am trying to modify it to fit my needs. The issue is that the sheets are being made after the existing sheets, and I need the data to be copied over to the already existing sheets.

Sub CopyWorkbook()
Dim sh As Worksheet, wb As Workbook
Set wb = Workbooks("Destination.xlsm")
For Each sh in Workbooks("Origin.xlsm")
sh.Copy After:=wb.Sheets(wb.Sheets.Count)
Next sh
End Sub

Any help would be greatly appreciated.

Answer 1

Copy Sheets to Another Workbook

• The following will delete existing destination sheets and replace them with the new versions of the source sheets. If a source sheet doesn't exist in the destination workbook, it will get copied to the last position.

Option Explicit

Sub CopySheets()
    Const ProcTitle  As String = "Copy Sheets"
    
    Const sExceptionsList As String = "Sheet1,Sheet2"
    Const dFilePath As String = "C:\Test\2021\69957615\Destination.xlsm"
    
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    
    Dim sExceptions() As String: sExceptions = Split(sExceptionsList, ",")
    
    Dim sshCount As Long: sshCount = swb.Sheets.Count
    Dim sshNames() As String: ReDim sshNames(1 To sshCount)
    
    Dim ssh As Object
    Dim sshName As String
    Dim dIndex As Long
    Dim n As Long

    
    ' Write the Source Sheet Names to an array.
    For Each ssh In swb.Sheets
        sshName = ssh.Name
        If IsError(Application.Match(sshName, sExceptions, 0)) Then
            n = n + 1
            sshNames(n) = sshName
        End If
    Next ssh
    If n < sshCount Then
        sshCount = n
        ReDim Preserve sshNames(1 To sshCount)
    End If
    
    Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
    Dim dshCount As Long: dshCount = dwb.Sheets.Count
    
    Dim dsh As Object
    
    Application.ScreenUpdating = False
    
    For n = 1 To sshCount
        sshName = sshNames(n)
        Set ssh = swb.Sheets(sshName)
        On Error Resume Next
            Set dsh = dwb.Sheets(sshName)
        On Error GoTo 0
        If dsh Is Nothing Then ' copy new sheet
            ssh.Copy After:=dwb.Sheets(dwb.Sheets.Count)
            dshCount = dshCount + 1
        Else ' copy existing sheet
            dIndex = dsh.Index
            Application.DisplayAlerts = False
            dsh.Delete
            Application.DisplayAlerts = True
            If dIndex = dshCount Then
                ssh.Copy After:=dwb.Sheets(dIndex - 1)
            Else
                ssh.Copy Before:=dwb.Sheets(dIndex)
            End If
        End If
        Set dsh = Nothing
    Next n
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheets copied.", vbInformation, ProcTitle
    
End Sub