Cut and Paste rows to new worksheet when row is empty-CodePudding

I am trying to separate some data from one worksheet into multiple worksheets using VBA. The data is separated by empty rows. I am a total noob in VBA and coding in general is there anyway to write a for loop that will cut and paste the rows in between the empty rows and put it into a new sheet.

Here is the macro that I recorded just cutting and pasting manually, I know this won't work for what I want to do what modifications should I make to it?

Sub blank()
'
' blank Macro
'
'
    Rows("1:26").Select
    Selection.Cut
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Sheets("1.8.22_8.17.22_demographics_rep").Select
    Rows("28:53").Select
    Selection.Cut
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Range("I40").Select
End Sub

CodePudding user response：

Sub Seperate_Data()

    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("YourWorksheetsName")
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    ws.Rows.Hidden = False
    
    Dim newSht As Worksheet
    Dim sheetNum As Integer: sheetNum = 1
    Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Dim lastCol As Long: lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    Dim r As Long: r = 1
    Dim top As Long: top = 1
    
    While r < lastRow
        While r <= lastRow And Not ws.Cells(r, 1).Value = ""
            r = r   1
        Wend
        Set newSht = ThisWorkbook.Sheets.Add
        newSht.name = "Copy - " & sheetNum
        sheetNum = sheetNum   1
        
        ws.Range(ws.Cells(top, 1), ws.Cells(r - 1, lastCol)).Copy Destination:=newSht.Range("A1")
        r = r   1
        top = r
    Wend

End Sub

good luck stinky