Import content from a sheet in workbook to a sheet in another new workbook

Sub processCC(sheet As Worksheet)
   Dim length As Integer, I As Integer
   Dim CC, CCFormat As String
   Dim dbl As Double
   Dim LastRow As Long, Row As Long
   
   LastRow = sheet.Cells(Rows.count, "D").End(xlUp).Row
   sheet.Range("D:D").NumberFormat = 0
   sheet.Range("D:D").NumberFormat = "@"
   For Row = 2 To LastRow
      If sheet.Range("D" & Row).Value <> "" Then
         CC = ""
         length = Len(sheet.Range("D" & Row).Value)
         For I = 1 To length
            If Mid(sheet.Range("D" & Row).Value, I, 1) <> " " Then CC = CC & Mid(sheet.Range("D" & Row).Value, I, 1)
         Next
         If Left(CC, 3) <> "000" Then CC = "000" & Format(CC, "0")
         sheet.Range("D" & Row) = CC
      End If
   Next

End Sub





Sub PushToBook()
Dim WS As Worksheet
Dim WSS As Worksheet
Dim NewWS As Worksheet
Dim MaxRow, I, J As Long
Dim NewWb As Workbook
Dim NewWorkB As String

If MsgBox("This process will create a new workbook with today's date and load in it all records in sheet 'MC Consolidated' that beare today's date." & Chr(10) & Chr(10) _
    & "Are you ready to start this process ?", vbQuestion + vbYesNo, "Push To Book") = vbYes Then

    Set WS = ActiveSheet
    Set NewWb = Workbooks.Add
    Set NewWS = NewWb.Sheets("Sheet1")
    NewWS.Name = Format(Now, "mm-dd-yyyy")
    
    'Mastercard - smSept9-11.xls'
    NewWb.SaveAs Filename:=ThisWorkbook.Path & "\Mastercard - sm" & Format(Now, "Mmmd-yy") & ".xls", FileFormat:=xlExcel8
    NewWorkB = NewWb.Name
    
    J = 1
    MaxRow = WS.UsedRange.Rows.count
    WS.UsedRange.AutoFilter Field:=10, Criteria1:=">=" & Date, Operator:=xlAnd, Criteria2:="<=" & Date
    For I = 1 To MaxRow
        If WS.Range(I & ":" & I).EntireRow.Hidden = False Then
            WS.Range("A" & I & ":I" & I).copy NewWS.Cells(J, 1)
            J = J + 1
        End If
    Next I
    WS.ShowAllData
    WS.AutoFilterMode = False
    
    processCC NewWS
       
    With NewWS.Columns("A:I")
       .EntireColumn.AutoFit
       .HorizontalAlignment = xlCenter
    End With
       
    Application.DisplayAlerts = False
    
    For Each WSS In NewWb.Worksheets
        If WSS.Name <> NewWS.Name Then WSS.Delete
    Next WSS
    
    
    NewWb.Close Savechanges:=True
    
    Set NewWb = Nothing
    Set NewWS = Nothing
    Application.DisplayAlerts = True
    
    WS.Activate
    MsgBox ("Workbook: '" & NewWorkB & "' has been created successfully")
    
End If
End Sub

Select allOpen in new window