VBA Question - Can anybody help me?

Hello,

I really have a problem on solving my VBA case. Hopefully the question can be solved by some masters of VBA.

Please see the attached spreadsheet for the your review.

I want to put sheet1 B29-D29 into sheet2 C3-E3
put sheet1 B33-D33 into sheet2 C3-E3
put sheet1 B37-D37 into sheet2 C4-E4
put sheet1 B41-D41 into sheet2 C5-E5
put sheet1 B45-D45 into sheet2 C6-E6 ... ...

When I put the following code on VBE Module1. it works well. However, it is a stupid way to compose such code:

Sub report()

Sheets("Sheet2").Range("C3:E3").Value = Sheets("Sheet1").Range("B29:D29").Value

Sheets("Sheet2").Range("C4:E4").Value = Sheets("Sheet1").Range("B33:D33").Value

Sheets("Sheet2").Range("C5:E5").Value = Sheets("Sheet1").Range("B37:D37").Value

Sheets("Sheet2").Range("C6:E6").Value = Sheets("Sheet1").Range("B41:D41").Value

Sheets("Sheet2").Range("C7:E7").Value = Sheets("Sheet1").Range("B45:D45").Value

Sheets("Sheet2").Range("C8:E8").Value = Sheets("Sheet1").Range("B49:D49").Value

Sheets("Sheet2").Range("C9:E9").Value = Sheets("Sheet1").Range("B53:D53").Value

Sheets("Sheet2").Range("C10:E10").Value = Sheets("Sheet1").Range("B57:D57").Value

End Sub

All I want the coding should be like the following, but unfortunately it doesn't work.

Sub report()

Dim i As Integer
Dim j As Integer
Dim k As Integer

For j = 1 To 8
k = k + 4
For i = 1 To 3

Sheets("Sheet2").Cells(j + 2, i + 2).Value = Sheets("Sheet1").Cells(k + 25, i + 1).Value

Next i
Do Until k = 57
Loop
Next j

End Sub

Could you please help me to rewrite the code above and make it work well?

Thank you for your concern and look forward to your reply.

Kind regards,
Lawrence

AttachmentSize
Q1 Report.xlsm16.63 KB

Very good suggestion. But I

Very good suggestion.
But I modified it as it did not copy b29.
I = 0
For I = 0 To 4
Sheets("Sheet2").Range("C3:E3").Offset(I).Value = Sheets("Sheet1").Range("B29:D29").Offset(I * 4).Value
Next

Nick's picture

try this Sub copyOver()

try this
Sub copyOver()
    i = 1
    For startRow = 28 To 8
        Sheets("Sheet2").Range("C3:E3").Offset(i).Value = Sheets("Sheet1").Range("B29:D29").Offset(i * 4).Value
        i = i + 1
    Next
End Sub