Copy Sheet and paste value with formatting to new sheet VBA

[mhunguyen]

Hi been a consistent user of this forum and never had the chance to ask anything. But hoping someone could help me with this. I have 4 sheets in a workbook and I want to copy and paste values a range with formating to a new workbook. I have completed the following using the record feature and modified it a bit. This works great for the one sheet that I have. But is there an easy way to apply this same code to the remaining 3 sheets?

Sub CopyWithFormatting()
Sheets("Select").Range("M1:W185").Copy
Workbooks.Add
Columns("A:AF").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

With ActiveSheet.Range("B1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Columns("C:C").EntireColumn.AutoFit
Columns("A:A").ColumnWidth = 2
Columns("D:L").ColumnWidth = 11.5
End With
'formating
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Select"
Range("A7").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 80

End Sub

Thanks so much for the help.

 

[mhunguyen]

Hi I just want to copy the 4 sheets in this workbook into a new workbook. The remaining sheets are just data supporting the 4 sheets that I want to copy. It's a management report, so I only need to copy the summary sheets.

Thanks!

 

[Fluff]

Which sheets do you need to copy & will they always have the same names?

 

[mhunguyen]

Which sheets do you need to copy & will they always have the same names?

They will always be the same name. Their names are "SelectAdv1", "SelectAdv2", "SelectAdv3", and "SelectAdv4".

 

[Fluff]

In that case try

   For Each Ws In ThisWorkbook.Worksheets(Array("SelectAdv1", "SelectAdv2", "SelectAdv3", "SelectAdv4"))

 

[mhunguyen]

Thank you, also the copy range in each sheet is different. For example Sheet Selectadv1 range to copy is M1:W185, the range in SelectAdv2 is P10:W185.

Thanks

 

[Fluff]

What are all the ranges & is there anything else that you haven't mentioned?

 

[mhunguyen]

Here are the ranges in each sheet.

Sheet Selectadv1 range to copy is M1:W185, the range in SelectAdv2 is P10:W185, SelectAdv3 is N10:W186, SelectAdv4 is N12:Z185.

Some other things, that I would like to do with this macro. 1) Save the file into my document and named the "Monthly SelectAdv Report". 2) If possible email this email using outlook to a list of people.

Thanks so much for the patience and help!

 

[Fluff]

How about

Sub CopyWithFormatting()
   Dim Wbk As Workbook, Twbk As Workbook
   Dim Shts As Long, i As Long
   Dim Ary As Variant
   
   Ary = Array("SelectAdv1", "M1:W185", "SelectAdv2", "P10:W185", "SelectAdv3", "N10:W186", "SelectAdv4", "N12:Z185")
   Set Twbk = ThisWorkbook
   With Application
      Shts = .SheetsInNewWorkbook
      .SheetsInNewWorkbook = 4
      Set Wbk = Workbooks.Add
      .SheetsInNewWorkbook = Shts
      .ScreenUpdating = False
   End With
   
   For i = 0 To UBound(Ary) Step 2
      Twbk.Sheets(Ary(i)).Range(Ary(i + 1)).Copy
      With Wbk.Sheets(i + 1).Columns("A:AF").Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = 0
         .PatternTintAndShade = 0
      End With
      
      With Wbk.Sheets(i + 1).Range("B1")
         .PasteSpecial xlPasteColumnWidths
         .PasteSpecial xlPasteValues
         .PasteSpecial xlPasteFormats
         .Columns("C:C").EntireColumn.AutoFit
         .Columns("A:A").ColumnWidth = 2
         .Columns("D:L").ColumnWidth = 11.5
         .Parent.Name = Ary(i)
      End With
      'formating
      Wbk.Sheets(i + 1).Select
      Range("A7").Select
      ActiveWindow.FreezePanes = True
      ActiveWindow.Zoom = 80
   Next Ws
   Application.CutCopyMode = False
End Sub

For the other two requests you will need to start a new thread