VBA: How to copy every nth row into multiple new worksheets?

Ryan Simmons
Ryan Simmons used Ask the Experts™
on
I am trying to loop through a spreadsheet and copy every 5th row of a sheet into multiple new worksheets. Basically every 5 rows of data should be placed into a new worksheet. The code I am trying to modify to suit my purposes is 

Option Explicit

Sub loopTest()
Dim hdr As Range 'header range
Dim dta As Range 'data range
Dim cl As Integer 'copy line
Dim ns As Excel.Worksheet

Set hdr = Excel.Worksheets(1).Range("A2:Q2") 'set this range for what ever range your headers are on
cl = 3 'set this value for what ever row your data starts on
Do While Excel.Worksheets(1).Range(Cells(cl, 1), Cells(cl, 1)).Value <> "" 'this stops the loop when there are no more records
Set dta = Excel.Worksheets(1).Range(Cells(cl, 1), Cells(cl + 2, 17)) 'this sets the data range change the number 3 to how ever many columns there are in your dataset
Set ns = Excel.Worksheets.Add(, ActiveSheet) 'this sets the new sheet to the ns (new sheet = ns ) variable
hdr.Copy
ns.Range("A1").PasteSpecial xlPasteAll
dta.Copy
ns.Range("A2").PasteSpecial xlPasteAll
cl = cl + 5
Loop

End Sub

Open in new window


I currently get an error on the line:
Do While Excel.Worksheets(1).Range(Cells(cl, 1), Cells(cl, 1)).Value <> "" 'this stops the loop when there are no more records

Open in new window


The error I am receiving is Application-defined or object-defined error. I am unsure how to interpret this error.

testworkbook with the code and error is attached.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You may try something like this. Please tweak it as per your requirement as per the comments added in the code.

Sub loopTest()
Dim wsData      As Worksheet
Dim ns          As Worksheet
Dim hdr         As Range 'header range
Dim dta         As Range 'data range
Dim cl          As Long 'copy line
Dim i           As Long
Dim LastRow     As Long
Dim dlr         As Long

Application.ScreenUpdating = False

Set wsData = Worksheets(1)  'Worksheets(1) is the Data sheet which is hidden in the file
Set hdr = wsData.Range("A1:L1") 'set this range for what ever range your headers are on. A1:L1 is the header row as per the Data Sheet
cl = 2 'set this value for what ever row your data starts on

LastRow = wsData.Cells(Rows.Count, "A").End(xlUp).Row

Set ns = Excel.Worksheets.Add(, ActiveSheet) 'this sets the new sheet to the ns (new sheet = ns ) variable

hdr.Copy ns.Range("A1") 'Copying the header row to the newly created sheet

For i = cl To LastRow Step 5 '5 here is the number of rows you want to skip
    dlr = ns.Cells(Rows.Count, "A").End(xlUp).Row + 1   'Finding the next empty row on the new sheet (ns)
    wsData.Range("A" & i & ":L" & i).Copy ns.Range("A" & dlr)   'Copying the columns A:L to the new worksheet (ns)
Next i

ns.UsedRange.Columns.AutoFit    'Autofit the columns on the ns sheet
Application.ScreenUpdating = True
End Sub

Open in new window

Ryan SimmonsBusiness Analyst III

Author

Commented:
Thanks for your help but I need the code to copy each 5 row segment of data into a new worksheet. For instance in the example file I need it to take rows 3 through 6 and copy that into Sheet1 then copy rows 8 through 11 into Sheet2 and so on...
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
Like this?

Sub loopTest()
Dim wsData      As Worksheet
Dim ns          As Worksheet
Dim hdr         As Range 'header range
Dim dta         As Range 'data range
Dim cl          As Long 'copy line
Dim i           As Long
Dim LastRow     As Long

Application.ScreenUpdating = False

Set wsData = Worksheets(1)  'Worksheets(1) is the Data sheet which is hidden in the file
Set hdr = wsData.Range("A1:L1") 'set this range for what ever range your headers are on. A1:L1 is the header row as per the Data Sheet
cl = 2 'set this value for what ever row your data starts on

LastRow = wsData.Cells(Rows.Count, "A").End(xlUp).Row

For i = cl - 1 To LastRow Step 5 '5 here is the number of rows you want to skip
    Set ns = Excel.Worksheets.Add(, ActiveSheet) 'this sets the new sheet to the ns (new sheet = ns ) variable
    hdr.Copy ns.Range("A1") 'Copying the header row to the newly created sheet
    Set dta = wsData.Range("A" & i + 1 & ":L" & i + 1)
    dta.Resize(4, dta.Columns.Count).Copy ns.Range("A2")  'Copying the columns A:L to the new worksheet (ns)
    ns.UsedRange.Columns.AutoFit    'Autofit the columns on the ns sheet
Next i

Application.ScreenUpdating = True
End Sub

Open in new window

Ryan SimmonsBusiness Analyst III

Author

Commented:
That will work I can take it the rest of the way. Thanks!
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
Great, No problem!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial