0

I have the below macro which I use to split out a workbook into individual files. What I need help with is getting the macro to ignore the first two sheets and only split out the rest (and then ideally delete them from the original workbook)?

The first two sheets will have static names "Summary" & "Invoice Breakdown"

Sub SaveSheetsFurnVill()

Dim rs As Worksheet

For Each rs In Sheets
rs.Name = rs.Range("A2")
Next rs

'RECOLOURING MACRO

   Dim myArray() As Variant
Dim i As Integer
For i = 1 To Sheets.Count
    ReDim Preserve myArray(i - 1)
    myArray(i - 1) = i
Next i
Sheets(myArray).Select

Rows("1:2").Select
With Selection.Interior
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
    Rows("1:1").Select
With Selection.Font
    .Color = -10272187
    .TintAndShade = 0
End With
Range("A3:K3").Select
With Selection.Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
With Selection.Interior
    .Pattern = xlSolid
    '.PatternColorIndex = -7
    .Color = -10272187
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
Range("A2:B2").Select
With Selection.Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
With Selection.Font
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
End With
    

' Save sheets as seperate workbooks
'
' Keyboard Shortcut: Ctrl+Shift+W
'
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc.
Dim strSavePath As String

On Error GoTo ErrorHandler

Application.ScreenUpdating = False 'Don't show any screen movement


strSavePath = "C:\Users\Jo Blogs\Documents\Save Sheets\" 'Change 
this to suit your needs

Set wbSource = ActiveWorkbook

For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & "Furniture Village Invoice Breakdown " & sht.Name & " " & 
Format(Date, "mmmm yyyy")
wbDest.Close 'Remove this if you don't want each book closed after saving.
Next

Application.ScreenUpdating = False

Exit Sub

ErrorHandler: 'Just in case something hideous happens
MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & 
Err.Description & "."


End Sub
BigBen
  • 46,229
  • 7
  • 24
  • 40
Gary O'Dea
  • 1
  • 1
  • 5
  • 1
    `If sht.Name <> "Summary" And sht.Name <> "Invoice Breakdown" Then`. – BigBen Mar 16 '22 at 16:40
  • 1
    You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Pᴇʜ Mar 16 '22 at 16:47
  • @BigBen - where would I add this into the code? I have tried before the recolouring section but I am getting a compile error. – Gary O'Dea Mar 17 '22 at 08:58
  • You'd also need to change `For i = 1 To Sheets.Count` if you want to skip the first two sheets, for example to `For i = 3`. – BigBen Mar 17 '22 at 13:10
  • `If sht.Name <> "Summary" And sht.Name <> "Invoice Breakdown" Then` is meant to go after `For Each sht In wbSource.Sheets`, and it also needs an `End If`. – BigBen Mar 17 '22 at 13:11

0 Answers0