Loop through multiple ranges

[jaesquibel]

First off, thanks for looking at this.

I am having a problem trying to figure out ow to move to the next set of cells. I have a list of data on say Sheets("Sheet1") that I need, starting in BA8 that goes down 6 rows to column DW. I need to loop through each columns set of six cells, copy and paste special values into a separate sheet "("Sheet2") in cells C4:C9. This populates a bunch of data based on formulas and distributes it to various sheets. The code works fine for the first entry but im stuck on the loop. Here is my code.
Sub Basic()
Application.ScreenUpdating = False
Dim source As Worksheet
Dim destination As Worksheet
Dim destination2 As Worksheet
Set source = Sheets("Sheet1")
Set destination = Sheets("Sheet2")
Set destination2 = Sheets("Sheet3")

'paste well into control panel
Sheets("Sheet1").Activate
Range("BA1:DW7").Copy
Range("BA8").PasteSpecial xlPasteValues
ActiveCell.Resize(6, 1).Copy destination.Cells(4, 3)
End Sub
Sub Eight()
Application.ScreenUpdating = False
Sheets("Sheet3").Activate
Dim r1 As Range, r2 As Range
Set r1 = Intersect(Range("F5:F75"), Cells.SpecialCells(xlCellTypeBlanks))
Set r2 = Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
'paste gross cost
Sheets("Sheet3").Activate
Range("BF1").Copy
If r1 Is Nothing Then
r2.PasteSpecial xlPasteValues
Else
r1(1).PasteSpecial xlPasteValues
End If
End Sub
Sub BassNet()
Application.ScreenUpdating = False
Sheets("Sheet3").Activate
Dim r3 As Range, r4 As Range
Set r3 = Intersect(Range("G5:G75"), Cells.SpecialCells(xlCellTypeBlanks))
Set r4 = Cells(Rows.Count, "G").End(xlUp).Offset(1, 0)
'paste net costs
Sheets("Sheet3").Activate
Range("BF2").Select
Range("BF2").Copy
If r3 Is Nothing Then
r4.PasteSpecial xlPasteValues
Else
r3(1).PasteSpecial xlPasteValues
End If
End Sub
Sub OilProd()
Application.ScreenUpdating = False
Sheets("Sheet4").Activate
Dim r5 As Range, r6 As Range
Set r5 = Intersect(Range("C3:C61"), Cells.SpecialCells(xlCellTypeBlanks))
Set r6 = Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
Sheets("Sheet4").Activate
Sheets("Sheet4).Select
Range("AN5").Select
Range("AN4:AY4").Copy
If r5 Is Nothing Then
r6.PasteSpecial xlPasteValues
Else
r5(1).PasteSpecial xlPasteValues
End If
Sheets("Sheet2").Activate
End Sub

 

[patel45]

can you paste a link to a sample file with data and desired result ?

 

[jaesquibel]

Honestly I am not quite sure how to do that. If it helps, my desired results are to take each 6 cell range starting at BA to DW in Sheet1, copy and paste that into C4 on Sheet 2 and then run all the stuff below it one 6 cell range at a time. The stuff below it doesnt change, the only problem is this section really.

'paste well into control panel
Sheets("Sheet1").Activate
Range("BA1:DW7").Copy
Range("BA8").PasteSpecial xlPasteValues
ActiveCell.Resize(6, 1).Copy destination.Cells(4, 3)
End Sub

I have attempted to use offset.(0,1) and it may be the answer but i am not sure how to use it.

If you can tell me how to post a link i will.