VBA code to make and save copy of template

[Tommyk]

Hi all,

I have a code which runs from a template that looks up a file in the same folder and then copies data from it to itself. This works great but i would like to end the macro by saving a copy of the template with a different file name (that off the feeder), which will overwrite if that file already exists.

The file name of the feeder document will be *MTS.xlsx (e.g E14MTS.xlsx)
I would like to save as *Stantec.xlsx (e.g E14Stantec.xlsx)

Thanks for any help.

Option Explicit
Sub test1()
    Dim wbTarget As Workbook
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim wsSource As Worksheet
    Dim strName As String
    Dim MyPath As String
    Dim sRng As Range
    Dim sCell As Range
    Dim LR As Long
    Dim i As Long

    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path

    Set wbTarget = ActiveWorkbook
    Set wsTarget = wbTarget.Sheets("Enter Materials Info")

    strName = "*MTS.xlsx"
    If Not IsWbOpen(strName) Then
        Set wbSource = Application.Workbooks.Open(MyPath & "\" & strName)
    Else
        Set wbSource = Workbooks(strName)
    End If

    Set wsSource = wbSource.Sheets("MTS")

    With wsSource
        LR = .Range("C" & .Rows.Count).End(xlUp).Row
        Set sRng = wsSource.Range("C2:C" & LR)
        i = 0

        For Each sCell In sRng
        wsTarget.Range("C2").Offset(1, i).Value = sCell.Value
            wsTarget.Range("C2").Offset(1, i).Value = sCell.Offset(0, 1).Value
            wsTarget.Range("C2").Offset(3, i).Value = sCell.Offset(0, 0).Value
            wsTarget.Range("C2").Offset(2, i).Value = sCell.Offset(0, 4).Value
            wsTarget.Range("C2").Offset(32, i).Value = sCell.Offset(0, 6).Value
            wsTarget.Range("C2").Offset(33, i).Value = sCell.Offset(0, 7).Value
            wsTarget.Range("C2").Offset(34, i).Value = sCell.Offset(0, 8).Value
            wsTarget.Range("C2").Offset(35, i).Value = sCell.Offset(0, 9).Value
            wsTarget.Range("C2").Offset(51, i).Value = sCell.Offset(0, 12).Value
            wsTarget.Range("C2").Offset(52, i).Value = sCell.Offset(0, 13).Value
            wsTarget.Range("C2").Offset(53, i).Value = sCell.Offset(0, 16).Value
            wsTarget.Range("C2").Offset(54, i).Value = sCell.Offset(0, 17).Value
            wsTarget.Range("C2").Offset(55, i).Value = sCell.Offset(0, 18).Value
            wsTarget.Range("C2").Offset(75, i).Value = sCell.Offset(0, 23).Value
            wsTarget.Range("C2").Offset(76, i).Value = sCell.Offset(0, 24).Value
            wsTarget.Range("C2").Offset(77, i).Value = sCell.Offset(0, 20).Value
            wsTarget.Range("C2").Offset(78, i).Value = sCell.Offset(0, 25).Value
            wsTarget.Range("C2").Offset(106, i).Value = sCell.Offset(0, 32).Value
            wsTarget.Range("C2").Offset(109, i).Value = sCell.Offset(0, 29).Value
            i = i + 1
        Next sCell
    End With
    Application.CutCopyMode = False
    wbSource.Close False, False
    Application.ScreenUpdating = True
End Sub

Function IsWbOpen(wbName As String) As Boolean
    Dim i As Long
    For i = Workbooks.Count To 1 Step -1
        If Workbooks(i).Name = wbName Then Exit For
    Next
    If i <> 0 Then IsWbOpen = True
End Function

 

[Tommyk]

I wish to close this thread, as it is no longer needed, but i do not have a edit option??

Thanks