CODEWITHSUNDEEP
excelvba
SkiBum
SkiBum

Reputation: 23

Excel VBA - duplicate rows

I need to duplicate a row that is full of formulas N times. N is defined by the number of rows on a different sheet. The formulas are unique per row, but I think autofill will handle that.

In "DestSheet": Row 1 is a header Row 2 has the line I want to replicate "Cnt" times, starting in Row 3. Row 2 has cells that are unique to the row - =Credentials!C2 I need Row 2 to be the same as row 2 but increment the row numbers So that I get =Credntials!C3 on row 3 and =Credentials!C4 on row 4 (other formulas are more complex - but follow the same model) When the function is done, "DestSheet" will have "Cnt" rows of what started on line 2

I am close from code I found on this site.....

Sub AddRows(Cnt As Integer, DestName As String)

    Dim DestSheet As Worksheet
    Dim i As Integer


    Set DestSheet = Worksheets(DestName)

    For i = 1 To Cnt

        Sheets(DestName).cell(i + 2, 1).AutoFill _
              Destination:=Range(LastRow)
    Next i
End Sub ' AddRows

Upvotes: 0

Views: 2763

Answers (2)

SkiBum
SkiBum

Reputation: 23

This is what I came up with:

sub x()
NbrRows = Sheets(SrcName).Range("A" & Rows.Count).End(xlUp).Row  ' get the number of rows on the  sheet to know how many rows to add to the dest sheet
If NbrRows > 1 Then
    Call AddRows(NbrRows, DestName)
End If

end sub

Sub AddRows(Cnt As Integer, DestName As String)

Dim DestSheet As Worksheet
Dim Dest As String


Set DestSheet = Worksheets(DestName)
' DestSheet.Activate

Dest = "3:" & Cnt

Sheets(DestName).Rows("2:2").Select
Selection.Copy
Sheets(DestName).Rows(Dest).Select
Sheets(DestName).Paste
Sheets(DestName).Range("A2").Select
Application.CutCopyMode = False

End Sub ' AddRows

Upvotes: 1

Scott Craner
Scott Craner

Reputation: 152505

You don't need to loop with autofill:

Sub AddRows(Cnt As Integer, DestName As String)

    Dim DestSheet As Worksheet
    Set DestSheet = Worksheets(DestName)

    DestSheet.Cells(2, 1).AutoFill _
              Destination:=DestSheet.Cells(2, 1).Resize(Cnt)

End Sub

The above will fill A2 down to the number Rows in CNT. If you want to fill the whole row 2 down, use this.

Sub AddRows(Cnt As Integer, DestName As String)

    Dim DestSheet As Worksheet
    Set DestSheet = Worksheets(DestName)
    Dim colcnt As Long
    With DestSheet
        colcnt = .Cells(2, .Columns.Count).End(xlToLeft).Column

        .Range(.Cells(2, 1), .Cells(2, colcnt)).AutoFill _
              Destination:=.Range(.Cells(2, 1), .Cells(2, colcnt)).Resize(Cnt)
    End With
End Sub

AS ZygD explained, Because of the variable in the Sub line, this cannot run on its own it must be called.

Sub CallAddRows()
Dim rwcnt as integer
dim DestShtNme as String

rwcnt = 20
DestShtNme = "Sheet1" 'Change to your sheet.

AddRows rwcnt, DestShtNme

End Sub

I assume in your code you are iterating through various sheets and calling this sub to send to add lines. The above is just an example. How you come up with the two variables to pass into the AddRows sub is up to you. The important part is that the variable get passed to the sub.

Upvotes: 2

Related Questions