How to copy Cells from 1 sheet to other Sheet using Macro?

[vvkalkundri]

Hi ,

I have a excel sheet where i want to copy the Cells from 1 excel sheet to other excel sheet in a specific order using macro.
copy A1:D1 in sheet1 and paste it to A1:D1 in sheet2.
Copy E1:F1 in sheet1 and paste it to A2:D2 in Sheet2 .
Copy G1:H1 in sheet1 and paste it to A3:D3 in Sheet2 .
Copy I1:H1 in sheet1 and paste it to A4:D4 in Sheet2 .

I want to repeat this operation for all the rows in the sheet ? How to go about this . I have a sample code. How to loop through the entire sheet ?

Saple code :

Sub Macro1()


Sheets("Sheet1").Select
Range("A1:C1").Select
Selection.Copy
Sheets("Sheet3").Select
Range("Ai:Ci").Select
ActiveSheet.Paste

Sheets("Sheet1").Select
Range("D1:F1").Select
Selection.Copy
Sheets("Sheet3").Select
Range("A2").Select
ActiveSheet.Paste

Sheets("Sheet1").Select
Range("A2:C2").Select
Selection.Copy
Sheets("Sheet3").Select
Range("A3").Select
ActiveSheet.Paste

Sheets("Sheet1").Select
Range("D2:F2").Select
Selection.Copy
Sheets("Sheet3").Select
Range("A4").Select
ActiveSheet.Paste

End Sub

 

[WinteE]

Try this :

Sub TestCopy()

i = Worksheets("Blad2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
j = 1

For a = 1 To i

    Sheets("Sheet1").Range("A" & a & ":D" & a).Copy
    Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlAll
    j = j + 1
    Sheets("Sheet1").Range("E" & a & ":F" & a).Copy
    Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlAll
    j = j + 1
    Sheets("Sheet1").Range("G" & a & ":H" & a).Copy
    Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlAll
    j = j + 1
    Sheets("Sheet1").Range("I" & a & ":K" & a).Copy
    Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlAll
    j = j + 1
    
Next a

End Sub

Success,
Erik

 

[Peter_SSs]

vvkalkundri

Welcome to the MrExcel board!

Assuming your last bit was to copy I1:J1 (not I1:H1), then this is my suggestion.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Copy_Rows()<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> bCol, bWidth<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    bCol = Array(1, 5, 7, 9) <SPAN style="color:#007F00">'<-- 1st column of each 'block' to be copied</SPAN><br>    bWidth = Array(4, 2, 2, 2) <SPAN style="color:#007F00">'<-- No of columns in each 'block'</SPAN><br>    s = <SPAN style="color:#00007F">UBound</SPAN>(bCol) + 1<br>    <SPAN style="color:#00007F">With</SPAN> Sheets("Sheet1")<br>        lr = .Cells(.Rows.Count, 1).End(xlUp).Row<br>        <SPAN style="color:#00007F">For</SPAN> r = 1 <SPAN style="color:#00007F">To</SPAN> lr<br>            <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> s - 1<br>                .Cells(r, bCol(i)).Resize(, bWidth(i)).Copy _<br>                    Destination:=Sheets("Sheet2").Cells((r - 1) * s + 1 + i, 1)<br>            <SPAN style="color:#00007F">Next</SPAN> i<br>        <SPAN style="color:#00007F">Next</SPAN> r<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[vvkalkundri]

Thank you both of you. Both the solution work flawlessley....