Need to grab Excel column format when splitting file in VBA

Question

I'm splitting a file into rows of 500 and creating a new file for each. However my file has columns that need to be formatted in specific ways (Text & Date).

Could anyone help me add something to my code that will grab the column format from the original file when creating the split files?

Here's my working code:

Sub dividerows()

Dim ACS As Range, Z As Long, New_WB As Workbook, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range

Dim Headers() As Variant
Dim AC As String: AC = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
'Dim AC As String: AC = ActiveWorkbook.Name This is the old way it was done. Replace with the above piece of code that removes the extension completely.



Set ACS = ActiveSheet.UsedRange

With ACS

    Headers = .Rows(1).Value
    Total_Columns = .Columns.Count
    
End With

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
    
    Z = Z + 1
    
    If Z > 1 Then Start_Row = Stop_Row + 1
    
    Stop_Row = Start_Row + 499
    
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
    
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
    
    Set New_WB = Workbooks.Add
    
    With New_WB
    
        With .Worksheets(1)
            .Cells(1, 1).Resize(1, Total_Columns) = Headers
            .Cells(2, 1).Resize(Copied_Range.Rows.Count, Total_Columns) = Copied_Range.Value
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & AC & "_Part" & Z & ".xlsx", FileFormat:=51
       .Close
       
    End With
    
    If Stop_Row = ACS.Rows.Count Then Exit Do
    
Loop

End Sub

I need the split files to have the column formatting from the original Worksheet.

Answer 1

• Change two lines which are marked with **change**

    With New_WB
    
        With .Worksheets(1)
            ACS.Rows(1).Copy .Cells(1, 1)  ' **change**
            Copied_Range.Copy .Cells(2, 1)  ' **change**
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & AC & "_Part" & Z & ".xlsx", FileFormat:=51
       .Close
       
    End With