Keep Header row when splitting worksheet

[cortexnotion]

Hi All

I'm splitting a worksheet into number of rows defined by the input box. I would like to keep the Header Row from the original book in each file. Can you help please?

Many thanks

Sub Test()

Application.ScreenUpdating = False

  Dim wb As Workbook
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range
Dim WorkbookCounter As Integer
Dim RowsInFile As Variant
Dim DMANumber As String
Dim FileName As String

RowsInFile = InputBox("How many rows?")
DMANumber = Range("L3").Value
  FileName = "CWDP_DMA-" & DMANumber & "_" & Format(Date, "dd-mm-yyyy") & "-"

  Set ThisSheet = ThisWorkbook.ActiveSheet
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1


  For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
  Set wb = Workbooks.Add

  Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 1, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A1")

  wb.SaveAs ThisWorkbook.Path & "\" & FileName & WorkbookCounter
    wb.Close

  WorkbookCounter = WorkbookCounter + 1
  Next p

Application.ScreenUpdating = True

End Sub

 

[Jaafar Tribak]

I am not sure I understand... What exactly do you mean by: " I would like to keep the Header Row from the original book in each file "
Which "original book" and which "each file"?

 

[dmt32]

Hi,
Untested & just a guess at what you want but see if this update to your code does what you want

Sub Test()

    Dim wb As Workbook
    Dim ThisSheet As Worksheet, ws As Worksheet
    Dim NumOfColumns As Long
    Dim RangeToCopy As Range, HeaderRange As Range
    Dim WorkbookCounter As Integer
    Dim RowsInFile As Variant
    Dim DMANumber As String, FileName As String
    
    Do
    RowsInFile = InputBox("How many rows?", "Enter Rows To Copy")
    If StrPtr(RowsInFile) = 0 Then Exit Sub
    Loop Until Val(RowsInFile) > 0
    
    Set ThisSheet = ThisWorkbook.ActiveSheet
    
    DMANumber = ThisSheet.Range("L3").Value
    FileName = "CWDP_DMA-" & DMANumber & "_" & Format(Date, "dd-mm-yyyy") & "-"
    
    
    NumOfColumns = ThisSheet.UsedRange.Columns.Count
    Set HeaderRange = ThisSheet.Cells(1, 1).Resize(, NumOfColumns)
    WorkbookCounter = 1
    
    Application.ScreenUpdating = False
    For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
    
        Set wb = Workbooks.Add
        
        Set RangeToCopy = Union(HeaderRange, ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 1, NumOfColumns)))
        
        RangeToCopy.Copy wb.Sheets(1).Range("A1")
        
        wb.SaveAs ThisWorkbook.Path & "\" & FileName & WorkbookCounter
        wb.Close False
        
        WorkbookCounter = WorkbookCounter + 1
        Set RangeToCopy = Nothing
        Next p
        
        Application.ScreenUpdating = True
        
End Sub

 

[cortexnotion]

dmt32 rows fantastic thank you!

 

[dmt32]

dmt32 rows fantastic thank you!

Glad updated code was what you wanted - many thanks for feedback

Dave