在庫リストを調査個所別シートに仕上げるエクセルVBA

Sub 場所別在庫表()
    Dim Wn As Variant, NWn As Variant
    Dim Zrow As Long, Zrowb As Long
        Worksheets("作業シート").Select
            Wn = SpaceName
            Range("E2").Value = Wn
            If Wn = "" Then
                NWn = Format(Now(), "yymmdd-hhmm")
            Else
                NWn = Wn
            End If
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = NWn
        Worksheets("作業シート").Select
            Zrow = Cells(Rows.Count, 6).End(xlUp).Row
            Range("E1", "J" & Zrow).Copy _
                Destination:=Worksheets(NWn).Range("A1")
            Application.CutCopyMode = False
            Worksheets(NWn).Select
            Range("G1") = "備考"
            Range("C" & Zrow + 1) = "合計"
            For Each CELS In Range(Cells(2, 2), Cells(Zrow, 2))
                If CELS.Value = "" Then
                    Rows(CELS.Row).Delete
                End If
            Next
            Zrowb = Cells(Rows.Count, 3).End(xlUp).Row
            For t = 2 To Zrowb
                If Len(Range("B" & t)) = 6 Then
                    Range("B" & t) = "0" & Range("B" & t)
                End If
            Next t
        Range("A:G").Font.Size = 10
        Range("A:A").ColumnWidth = 8
        Range("B:B").ColumnWidth = 15
        Range("C:C").ColumnWidth = 25
        Range("D:D").ColumnWidth = 10
        Range("E:E").ColumnWidth = 10
        Range("G:G").ColumnWidth = 10
        Range("A1").RowHeight = 21
        Range("A1").Select
        With Range("F:F")
            .NumberFormatLocal = "\#,##0;\-#,##0"
            .ColumnWidth = 10
        End With
        With Worksheets(NWn).PageSetup
            .PrintTitleRows = "$1:$1"
            .PrintTitleColumns = ""
            .PrintArea = "A1:G" & Zrowb
            .CenterHeader = "書誌在庫表" & "（" & NWn & "）"
            .RightHeader = Date & Chr(10) & ShopName
            .CenterFooter = "&P" & "/" & "&N"
            .PaperSize = xlPaperA4
            .Orientation = xlPortrait
            .LeftMargin = Application.CentimetersToPoints(2)
            .RightMargin = Application.CentimetersToPoints(0.5)
            .TopMargin = Application.CentimetersToPoints(3)
            .BottomMargin = Application.CentimetersToPoints(1)
            .HeaderMargin = Application.CentimetersToPoints(1.5)
            .FooterMargin = Application.CentimetersToPoints(1.5)
        End With
        Range("F" & Zrowb) = WorksheetFunction. _
                        Sum(Range("F2", "F" & Zrowb - 1))
        Range(Cells(1, 1), Cells(Zrowb, 7)).Select
        With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
            Range("A1").Select
End Sub