Copy range in Sheet B n times for each row in Sheet A

[Brutusar]

This should be a simple thing, but I still manage to mess it up.

In a workbook there are two sheets, A and B.
In sheet A there are 1000 rows and 7 columns. (the numbers of rows will vary.) Col A will always be filled with data (no empty cells before last row)
In sheet B there is a range, A1 to G1 to last row. Last row will vary.
What I need to do to copy the complete range in sheet B, and copy it in after each row in sheet A.

I am using this code, but something is wrong. In the example the range in sheet B has 30 rows.

Sub CopyPasteRangeN_Times()
    
     Worksheets("A").Activate
     Application.ScreenUpdating = False
     Application.Calculation = xlManual
    
Dim LastrowA As Long, LastrowB As Long, i As Long

LastrowA = Range("A" & Rows.Count).End(xlUp).Row

Worksheets("B").Activate

Sheets("Sheet B").Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
Worksheets("A").Activate

For i = 39 To Lastrow Step 39

    Range("A" & i).Paste
    
Next i
End Sub

 

[Fluff]

Which is the first row the data should be pasted into?
Also do you just want values?

 

[Brutusar]

Hi,

The first row will always be row 2, and it is only values.

 

[Fluff]

So you want the data from sheet B to be pasted inserted into every other row on sheet A starting at row 2?

 

[Norie]

This will insert the data from columns A:G on sheet B in between each row of sheet A.

Sub CopyPasteRangeN_Times()
Dim rngDst As Range
Dim rngSrc As Range
  
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Set rngDst = Worksheets("A").Range("A3")

    Set rngSrc = Sheets("B").Range("A1:G" & Sheets("B").Cells(Rows.Count, "A").End(xlUp).Row)

    Do
        rngSrc.Copy
        rngDst.Insert xlShiftDown
        Set rngDst = rngDst.Offset(1)
    Loop Until rngDst.Value = ""
    
End Sub

 

[Fluff]

Another option that does values only, as requested.

Sub Brutusar()
   Dim Ary As Variant
   Dim i As Long
   
   With Sheets("B")
      Ary = .Range("A1:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   With Sheets("A")
      For i = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -2
         .Rows(i + 1).Resize(UBound(Ary) - 1).Insert
         .Range("A" & i).Resize(UBound(Ary), 7).Value = Ary
      Next i
   End With
End Sub

 

[Brutusar]

Both codes are working perfectly. Thank you very much for sharing your knowledge and taking the time to do so!!

 

[Fluff]

Glad we could help & thanks for the feedback.