Fill the blank rows of sheet1 with the rows in sheet2-CodePudding

In excel workbook named TEST, I wish to create a contacts list, where I wish to place Gmail ID's for every 6th row of a sheet containing 500 email contacts. To fulfill my requirement I have separated Gmail ID's from Sheet1 and placed in Sheet2. There are 38 Gmail ID's which are to be placed in every 6th row in Sheet1. To do this I have inserted blank rows for every 6th in the Sheet1. So, now I wish to fill the Sheet1 blank cells with the Gmail ID's in Sheet2. In VBA I wrote the code mentioned below to fill the blank cells. But, this appears to be lengthy. Can anyone help me by minimizing this code with simple steps.

Sub Copy_from_Another_Workbook_1()

    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$2:$D$2").Copy
    Sheets("Sheet1").Range("Sheet1!$A$7:$D$7").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$3:$D$3").Copy
    Sheets("Sheet1").Range("Sheet1!$A$13:$D$13").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$4:$D$4").Copy
    Sheets("Sheet1").Range("Sheet1!$A$19:$D$19").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$5:$D$5").Copy
    Sheets("Sheet1").Range("Sheet1!$A$25:$D$25").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$6:$D$6").Copy
    Sheets("Sheet1").Range("Sheet1!$A$31:$D$31").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$7:$D$7").Copy
    Sheets("Sheet1").Range("Sheet1!$A$37:$D$37").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$8:$D$8").Copy
    Sheets("Sheet1").Range("Sheet1!$A$43:$D$43").PasteSpecial
    Workbooks("TEST.xlsx").Worksheets("Sheet2").Range("Sheet2!$A$9:$D$9").Copy
    Sheets("Sheet1").Range("Sheet1!$A$49:$D$49").PasteSpecial
End Sub

CodePudding user response：

Should work. It copies the n=i 1 row of sheet2 to the n=6i 1 row of sheet1.

Sub Copy_from_Another_Workbook_1()
For i = 1 To 38
Worksheets("Sheet1").Range("A"   CStr(6 * i   1)   ":D"   CStr(6 * i   1)).Value = Worksheets("Sheet2").Range("A"   CStr(i   1)   ":D"   CStr(i   1)).Value
Next
End Sub

Hope it helped