Copying a block of cells within a range of cells

[Mike]

I have a sheet that has 40000 numbers in a column. I need
to copy the first 6 cells to a different column out of a
subgrouping that is every 200 numbers. In other words, I
need to copy cells 1 through 6 and 201-206, 401-406, etc.
Can anyone tell me how to do this? Thanks.

 

[Rob van Gelder]

Sub test()
Dim i As Long, rng As Range

With ActiveSheet
For i = 1 To 40000 Step 200
If rng Is Nothing Then
Set rng = Range(.Cells(i, 1), .Cells(i + 5, 1))
Else
Set rng = Union(rng, Range(.Cells(i, 1), .Cells(i + 5, 1)))
End If
Next
End With

rng.Copy Sheet2.Cells(1, 1)
End Sub

 

[Ron de Bruin]

Try this example

Sub test()
b = 1
For a = 1 To 1000 Step 200
Cells(a, "A").Resize(6, 1).Copy Cells(b, "B")
b = b + 6
Next
End Sub

It will copy from Column A to B

 

[Trevor Shuttleworth]

Mike

one way:

Sub CopySixCells()
Dim LastRow As Long
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1
j = 1
Do Until i > LastRow
Range("A" & i & ":A" & i + 5).Copy Range("B" & j)
i = i + 200
j = j + 6
Loop
Application.ScreenUpdating = True
End Sub

Regards

Trevor

 

[Ron de Bruin]

Change the 1000 to 40000

 

[Trevor Shuttleworth]

Another variation:

Sub CopySixCells()
Dim LastRow As Long
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
LastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1
j = 1
Do Until i > LastRow
Range("A" & i).Resize(6, 1).Copy Range("C" & j)
i = i + 200
j = j + 6
Loop
Application.ScreenUpdating = True
End Sub

Regards

Trevor

 

[Mike]

Thanks for all the help everyone. I really appreciate it!