Create identical workbooks & Search and Replace Single Word in all Worksheets + Save

[tornado64]

Hi,

I have a template sheet I want to duplicate about 65 times but each time with another file name and I want to replace every occurrence of one word. Afterwards I want to combine all the created data into one workbook.

I found macros for search & replace:

Sub FindReplaceAll()'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com


Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant


fnd = "Mitte"
rplc = "Testing"


For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht


End Sub
End Sub

Source: Find and Replace All With Excel VBA

and for consolidating worksheets into one Workbook:

[COLOR=blue][FONT=Consolas]Sub[/FONT][/COLOR][COLOR=#000000][FONT=Consolas] CopyRangeFromMultiWorksheets()[/FONT][/COLOR]    [COLOR=blue]Dim[/COLOR] sh [COLOR=blue]As[/COLOR] Worksheet
    [COLOR=blue]Dim[/COLOR] DestSh [COLOR=blue]As[/COLOR] Worksheet
    [COLOR=blue]Dim[/COLOR] Last [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]Dim[/COLOR] CopyRng [COLOR=blue]As[/COLOR] Range

    [COLOR=blue]With[/COLOR] Application
        .ScreenUpdating = [COLOR=blue]False[/COLOR]
        .EnableEvents = [COLOR=blue]False[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]

    [COLOR=green]' Delete the summary sheet if it exists.[/COLOR]
    Application.DisplayAlerts = [COLOR=blue]False[/COLOR]
    [COLOR=blue]On[/COLOR] [COLOR=blue]Error[/COLOR] [COLOR=blue]Resume[/COLOR] [COLOR=blue]Next[/COLOR]
    ActiveWorkbook.Worksheets([COLOR=#A31515]"RDBMergeSheet"[/COLOR]).Delete
    [COLOR=blue]On[/COLOR] [COLOR=blue]Error[/COLOR] [COLOR=blue]GoTo[/COLOR] 0
    Application.DisplayAlerts = [COLOR=blue]True[/COLOR]

    [COLOR=green]' Add a new summary worksheet.[/COLOR]
    [COLOR=blue]Set[/COLOR] DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = [COLOR=#A31515]"RDBMergeSheet"[/COLOR]

    [COLOR=green]' Loop through all worksheets and copy the data to the [/COLOR]
    [COLOR=green]' summary worksheet.[/COLOR]
    [COLOR=blue]For[/COLOR] [COLOR=blue]Each[/COLOR] sh [COLOR=blue]In[/COLOR] ActiveWorkbook.Worksheets
        [COLOR=blue]If[/COLOR] sh.Name <> DestSh.Name [COLOR=blue]Then[/COLOR]

            [COLOR=green]' Find the last row with data on the summary worksheet.[/COLOR]
            Last = LastRow(DestSh)

            [COLOR=green]' Specify the range to place the data.[/COLOR]
            [COLOR=blue]Set[/COLOR] CopyRng = sh.Range([COLOR=#A31515]"A1:G1"[/COLOR])

            [COLOR=green]' Test to see whether there are enough rows in the summary[/COLOR]
            [COLOR=green]' worksheet to copy all the data.[/COLOR]
            [COLOR=blue]If[/COLOR] Last + CopyRng.Rows.[COLOR=blue]Count[/COLOR] > DestSh.Rows.[COLOR=blue]Count[/COLOR] [COLOR=blue]Then[/COLOR]
                MsgBox [COLOR=#A31515]"There are not enough rows in the "[/COLOR] & _
                   [COLOR=#A31515]"summary worksheet to place the data."[/COLOR]
                [COLOR=blue]GoTo[/COLOR] ExitTheSub
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]

            [COLOR=green]' This statement copies values and formats from each [/COLOR]
            [COLOR=green]' worksheet.[/COLOR]
            CopyRng.Copy
            [COLOR=blue]With[/COLOR] DestSh.Cells(Last + 1, [COLOR=#A31515]"A"[/COLOR])
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = [COLOR=blue]False[/COLOR]
            [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]

            [COLOR=green]' Optional: This statement will copy the sheet [/COLOR]
            [COLOR=green]' name in the H column.[/COLOR]
            DestSh.Cells(Last + 1, [COLOR=#A31515]"H"[/COLOR]).Resize(CopyRng.Rows.[COLOR=blue]Count[/COLOR]).Value = sh.Name

        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR]

ExitTheSub:

    Application.[COLOR=blue]Goto[/COLOR] DestSh.Cells(1)

    [COLOR=green]' AutoFit the column width in the summary sheet.[/COLOR]
    DestSh.Columns.AutoFit

    [COLOR=blue]With[/COLOR] Application
        .ScreenUpdating = [COLOR=blue]True[/COLOR]
        .EnableEvents = [COLOR=blue]True[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR] [COLOR=blue][FONT=Consolas]End[/FONT][/COLOR][COLOR=blue][FONT=Consolas]Sub[/FONT][/COLOR]

Source: https://msdn.microsoft.com/en-us/library/cc793964(v=office.12).aspx

I also found a macro for creating workbooks and copying data into them:

Sub details()

Dim thisWB  As String


Dim newWB As String


    thisWB = ActiveWorkbook.Name
        
    On Error Resume Next
    Sheets("tempsheet").Delete
    On Error GoTo 0
        
    Sheets.Add
    ActiveSheet.Name = "tempsheet"
        
    Sheets("Sheet1").Select
        
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
            
        On Error Resume Next
            
        ActiveSheet.ShowAllData
            
        On Error GoTo 0
        
    End If
        
    Columns("B:B").Select
    Selection.Copy
        
    Sheets("tempsheet").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
        
    If (Cells(1, 1) = "") Then
        lastrow = Cells(1, 1).End(xlDown).Row
            
        If lastrow <> Rows.Count Then
            Range("A1:A" & lastrow - 1).Select
            Selection.Delete Shift:=xlUp
        End If
        
    End If
        
    Columns("A:A").Select
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
                CopyToRange:=Range("B1"), Unique:=True
        
    Columns("A:A").Delete
        
    Cells.Select
    Selection.Sort _
            Key1:=Range("A2"), Order1:=xlAscending, _
            Header:=xlYes, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        
    lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row
        
    For suppno = 2 To lMaxSupp
        
        Windows(thisWB).Activate


        supName = Sheets("tempsheet").Range("A" & suppno)
            
        If supName <> "" Then


            Workbooks.Add
            ActiveWorkbook.SaveAs supName
            newWB = ActiveWorkbook.Name
                
            Windows(thisWB).Activate


            Sheets("Sheet1").Select
            Cells.Select
                
            If ActiveSheet.AutoFilterMode = False Then
                Selection.AutoFilter
            End If
                
            Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _
                        Operator:=xlAnd, Criteria2:="<>"
                
            lastrow = Cells(Rows.Count, 2).End(xlUp).Row


            Rows("1:" & lastrow).Copy
                
            Windows(newWB).Activate
            ActiveSheet.Paste


            ActiveWorkbook.Save
            ActiveWorkbook.Close
                
        End If
        
    Next
        
    Sheets("tempsheet").Delete
        
    Sheets("Sheet1").Select
    If ActiveSheet.AutoFilterMode Then
        Cells.Select
        ActiveSheet.ShowAllData
    End If


End Sub

Source: Excel - Macro to create new workbook and copy data

However I couldn't find a macro that would do all of this combined.
Can anyone help me how to use the multiple macros together that can perform this?
Any help would be appreciated.