CODEWITHSUNDEEP
vbaexcelloops
JackC
JackC

Reputation: 11

Loop Copy/Paste every Nth row into new sheet?

I am a complete VBA newbie and am not proficient enough to decipher some solutions I've seen in the web. I'm hoping a guru can stamp out a quick VBA loop and I can play around with it.

I'm simply trying to: 

Copy every 3 rows from Sheet1. Paste 3 rows into new sheet (Sheet2).
Copy next 3 rows from Sheet1, and paste into another new sheet (Sheet 3).

I want to loop this function until the rows are blank.

I've recorded VBA of this function and it runs only once. I need it to loop till the rows are blank.

    Sub countrySplit()
    '
        Sheets("vs Target").Select
        Range("A5:N5, A6:N8").Select
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Select
        Range("A1").Select
        ActiveSheet.Paste
        ActiveSheet.Name = ActiveSheet.Range("$A$2")


End Sub

Upvotes: 0

Views: 2335

Answers (1)

The Gambill
The Gambill

Reputation: 181

@JackC ... Here is how I would do it... there are many ways of course but give this one a try if you want. Just edit it per the notes in the code to adjust for your workbook if you do not then not all your data will copy to the new sheets.. 

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("A1:C1") 'set this range for what ever range your headers are on
cl = 2 '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, 3)) '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 + 3
Loop

End Sub

Upvotes: 1

Related Questions