VBA to Copy and pastespecial sheets to another workbook

[sanket_sk]

Hi All,

This might be a silly question however I am stuck at one of the VBA code.

I am using the following VBA code to create multiple files from the details available in the source workbook "Data" Sheet, code is updating details in "Templete" sheet and then saving as new work book, code is working absolutely fine however along with "Data" & "Templete" sheet I have 10 more sheets in source workbook, out of 10 I want to add 8 sheets from source ( I mean I want to copy rest all sheets except "Data" & "File Creation" Sheet) in the workbook created by this code with same sheet name and formating available in source sheet.

Could you please help me build the code for this activity?


Current Code

Sub CRFiles()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Dest As Worksheet
Dim Trans As Worksheet
Dim CRFILE As Worksheet

Set Dest = ThisWorkbook.Sheets("Data")
Set Trans = ThisWorkbook.Sheets("DA_MISC_Claim")
Set CRFILE = ThisWorkbook.Sheets("File Creation")


Application.DisplayStatusBar = True
Application.StatusBar = ""

Dim i As Integer
Dim File_Name As String

Dim nwb As Workbook

For i = 2 To Dest.Range("A" & Application.Rows.Count).End(xlUp).Row

Application.StatusBar = i - 1 & "/" & Dest.Range("A" & Application.Rows.Count).End(xlUp).Row - 1

Trans.Range("C9").Value = Dest.Range("C" & i).Value
Trans.Range("C11").Value = Dest.Range("E" & i).Value
Trans.Range("J11").Value = Dest.Range("F" & i).Value
Trans.Range("G18").Value = Dest.Range("G" & i).Value
Trans.Range("G19").Value = Dest.Range("H" & i).Value
Trans.Range("G20").Value = Dest.Range("I" & i).Value
Trans.Range("C13").Value = Dest.Range("B" & i).Value

File_Name = Dest.Range("E" & i).Value & "_" & Dest.Range("C" & i).Value & ".xlsx"
Trans.Copy
Set nwb = ActiveWorkbook
nwb.Sheets(1).UsedRange.Copy
nwb.Sheets(1).UsedRange.PasteSpecial xlPasteValues
nwb.Sheets(1).Range("A1").Select


nwb.SaveAs CRFILE.Range("F4").Value & "\" & File_Name
nwb.Close False


Next i

Application.StatusBar = ""

MsgBox "Activity Completed"

End Sub