VBA to split data to worksheet/workbook , delete zero values, set print area

[Rookie2016]

I have a macro that currently works for me (after much help from others on another thread) but I would like some help tweaking it.
Please note that the subtotal function excludes the first sheet because doing so isn't necessary and will cause excel to crash due to #of rows.



1. On Sheet 1, how can I delete any rows that have zero value on Column K?

2. The data is split into worksheets by column A (Invoice #) but it isn't done in alphabetical order, even if the first sheet is in alphabetical order. How can I change that?

3. How can I save each tab as a separate Excel 2013 file without deleting it in the original sheet?

4. I have a print area set that includes all columns but I would like to auto detect how many pages are needed. The limit of rows I would like to have in one page is 75. For ex, an invoice with 230+ rows would require 4 sheets.

Sub Invoice()


Dim ws As Worksheet, a, e, dic As Object
     

      Cells.Select
              With Selection.Font
                    .Name = "Arial Narrow"
                    .Size = 10
                    Rows("1:10000").RowHeight = 15
                    Columns("K:L").Select
                    Selection.Style = "Comma"
	 	
End With

 ActiveSheet.Range("a1:W1").Select
 Selection.Copy
 On Error Resume Next
 Application.ScreenUpdating = False
 For Each ws In Worksheets
 ws.Columns("A:W").Sort Key1:=ws.Columns("J"), Order1:=xlDescending, Key2:=ws.Columns("O"),   Order2:=xlAscending
   Next ws
   ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll
   Application.ScreenUpdating = True

    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("sheet1").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        a = .Columns(1).Offset(1).Resize(.Rows.Count - 1).Value
        For Each e In a
            If Not dic.exists(e) Then
                dic(e) = Empty
                If Not Evaluate("isref('" & e & "'!a1)") Then
                    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = e
                End If
                Sheets(e).Cells.Clear
                .AutoFilter 1, e
                .Copy Sheets(e).Cells(1)
                With Sheets(e).Cells(1).CurrentRegion
                   
 .Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(11, 12)
               .Parent.Cells.ClearOutline
     	.Columns.AutoFit
           	.PageSetup.PrintTitleRows = "$1:$1"
If .Rows.Count > 75 Then
    	For i = 76 To .Rows.Count Step 75
   	.Parent.HPageBreaks.Add before:=.Rows(i)
                        Next
      	End If
                    	With .Parent.PageSetup
                    	.Orientation = xlLandscape
                        	.FitToPagesWide = 1  '? ---- changed
                        	.Zoom = False
End With
                   	 .AutoFilter
         
    	End With
   		 Application.ScreenUpdating = True
 
     	End If
 Next
 	End With
  
End Sub

[gmr4evr1]

I think I can help with # 1. Add the following code into your existing code to delete rows that contain 0

 Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    

    With Sheets("Sheet1")
    .Select
    End With

    Firstrow = 2
    Lastrow = Cells(Rows.Count, "K").End(xlUp).Row
    For Lrow = Lastrow To Firstrow Step -1

    With Cells(Lrow, "K")

         If Not IsError(.Value) Then

         If .Value = 0 Then .EntireRow.Delete
    
    End If
     End With
   Next Lrow

[mgs73]

This should help with questions 1 and 3:

Public Sub DeleteRowsAndSave()
  Dim r As Long
  Dim sh As Worksheet
  Dim wb As Workbook
  
  Set sh = ThisWorkbook.Worksheets("Sheet1")
  
  For r = sh.UsedRange.Rows.Count To 1 Step -1
    If sh.Cells(r, 11).Value = 0 Then sh.Rows(r).Delete
  Next
  
  sh.Copy
  ActiveWorkbook.SaveAs "D:\Temp\Test.xlsx"
  ActiveWorkbook.Close
End Sub

Unrelated to you questions, let me suggest you avoid using 'Select' - it is almost never needed, and it really slows things down. As an example, you can replace

ActiveSheet.Range("a1:W1").Select
 Selection.Copy

with

ActiveSheet.Range("a1:W1").Copy

[Rookie2016]

gmr4evr1 - Thank you for that code, it worked! this solved request #1.

mgs73 - that didn't seem to work. As far as the alphabetical order of the sheets being saved, I realized it's because of the sorting that I have, I only intended it to do so on the sheets that are created. I'm attempting to include this after the Next ws portion but I'm getting an error (Compile Error: Next without For). Please see below. How can I properly move the highlighted yellow code?

Sub Invoice()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    

    With Sheets("Sheet1")
    .Select
    End With

    Firstrow = 2
    Lastrow = Cells(Rows.Count, "K").End(xlUp).Row
    For Lrow = Lastrow To Firstrow Step -1

    With Cells(Lrow, "K")

         If Not IsError(.Value) Then

         If .Value = 0 Then .EntireRow.Delete
    
    End If
     End With

   Next Lrow

Dim ws As Worksheet, a, e, dic As Object
     

      Cells.Select
              With Selection.Font
                    .Name = "Arial Narrow"
                    .Size = 10
                    Rows("1:10000").RowHeight = 15
                    Columns("K:L").Select
                    Selection.Style = "Comma"
        
End With


   Next ws
 ActiveSheet.Range("a1:W1").Copy
 On Error Resume Next
 Application.ScreenUpdating = False
 For Each ws In Worksheets
 ws.Columns("A:W").Sort Key1:=ws.Columns("J"), Order1:=xlDescending, Key2:=ws.Columns("O"), Order2:=xlAscending

   ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll
   Application.ScreenUpdating = True

    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("sheet1").Cells(1).CurrentRegion
        .Parent.AutoFilterMode = False
        a = .Columns(1).Offset(1).Resize(.Rows.Count - 1).Value
        For Each e In a
            If Not dic.exists(e) Then
                dic(e) = Empty
                If Not Evaluate("isref('" & e & "'!a1)") Then
                    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = e
                End If
                Sheets(e).Cells.Clear
                .AutoFilter 1, e
                .Copy Sheets(e).Cells(1)
                With Sheets(e).Cells(1).CurrentRegion
                   
 .Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(11, 12)
               .Parent.Cells.ClearOutline
        .Columns.AutoFit
            .PageSetup.PrintTitleRows = "$1:$1"
If .Rows.Count > 75 Then
        For i = 76 To .Rows.Count Step 75
    .Parent.HPageBreaks.Add before:=.Rows(i)
                        Next
        End If
                        With .Parent.PageSetup
                        .Orientation = xlLandscape
                            .FitToPagesWide = 1  '? ---- changed
                            .Zoom = False
End With
                     .AutoFilter
         
        End With
         Application.ScreenUpdating = True
 
        End If
 Next
    End With
  
End Sub

[gmr4evr1]

I'm glad that my post worked for you.
I think your Next without For error might have to do with the Next ws. You have to have a For in order to use Next. in this case, I think you need a For ws = .......

[Rookie2016]

gmr4evr1 - that didn't work but it's possible I did this incorrectly. Would you mind sharing your suggestion within the coding I previously provided?

Thanks in advance.