Export workbook

ub EXWA_Plain_Validation()'Designed by Riktor & Dolf
'September 2014
     
    Dim destSheet As Worksheet
    Dim keyRange As Range
    Dim copyRange As Range
    Dim copyRange2 As Range
    Dim copyRange3 As Range
    Dim pasteRange As Range
    Dim pasteRange2 As Range
    Dim pasteRange3 As Range
    Dim recCount As Long
    Dim myWord As String
    Dim lastRow As Long
    Dim FinalRow As Integer
    Dim I       As Long
     
    FinalRow = Worksheets("Input file").Range("A" & Rows.Count).End(xlUp).Row
     'Define our range with words to replace
    Set keyRange = Worksheets("Input file").Range("A2:D" & FinalRow)
     'Create a new output sheet
     
    Application.ScreenUpdating = False
     
    With Worksheets("Template EXWA PLAIN")
        Set copyRange3 = .Range("60:93")
        Set copyRange = .Range("94:104")
        Set copyRange2 = .Range("105:106")
    End With
     
    Application.ScreenUpdating = True
     
    For recCount = 1 To keyRange.Rows.Count Step 60
        Set destSheet = ThisWorkbook.Worksheets.Add
         'Give a header. Needed for later Find method
        destSheet.Range("A1").Value = "OUTPUT"
        copyRange3.Copy destSheet.Cells(destSheet.Cells.Find("*", destSheet.Range("A1"), , , xlRows, xlPrevious).Row, 1)
         
        For I = recCount To recCount + 59
             'Copy range to new sheet
            copyRange.Copy destSheet.Cells(destSheet.Cells.Find("*", destSheet.Range("A1"), , , xlRows, xlPrevious).Row + 1, 1)
             'Figure out where we pasted to
            Set pasteRange = destSheet.Cells.Find("*", destSheet.Range("A1"), , , xlRows, xlPrevious).Offset(-copyRange.Rows.Count + 1).Resize(copyRange.Rows.Count).EntireRow
             'Make our replacements
            pasteRange.Replace "DDMMYY", Format(keyRange.Cells(I, 3).Value, "DD/MM/YYYY"), LookAt:=xlPart
            pasteRange.Replace "XX0000000000", keyRange.Cells(I, 1).Value, LookAt:=xlPart
        Next
         'Copy range to new sheet
        copyRange2.Copy destSheet.Cells(destSheet.Cells.Find("*", destSheet.Range("A1"), , , xlRows, xlPrevious).Row + 1, 1)
         'Figure out where we pasted to
        Set pasteRange2 = destSheet.Cells.Find("*", destSheet.Range("A1"), , , xlRows, xlPrevious).Offset(-copyRange2.Rows.Count + 1).Resize(copyRange2.Rows.Count).EntireRow
         'Make our replacements
    Next recCount
     
    Application.ScreenUpdating = True
     
    
    Set destSheet = Nothing
     
End Sub

ActiveSheet.Copy
    Set Destwb = ActiveWorkbook




    'Determine the Excel version and file extension/format
    With Destwb
            'You use Excel 2007-2013
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".ebm": FileFormatNum = -4158
  End Select
    End With




    'Save the new workbook and close it
    TempFilePath = "J:\temp\"
    TempFileName = "Input " & Sourcewb.Name & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")




    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close SaveChanges:=False
    End With




    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub