CODEWITHSUNDEEP
vbaexcelmacros
Katy Torres
Katy Torres

Reputation: 137

Copy cells "n" number of times. "n" is user specified

I am trying to code a macro that will look at the numerical user input in one sheet and will copy something that number of times in another sheet.

For example, I want to copy the company name and ID "n" times. "n" is specified in the last column in the same row.

Sheet1

company name | company ID | number of items purchased here
----------------------------------------------
blue company |  999       | 2
rose company |  444       | 1
gold company |  222       | 3

Sheet 2

company name | company ID
---------------------------
blue company | 999
blue company | 999
rose company | 444
gold company | 222
gold company | 222
gold company | 222

this code does something similar but the range selected for hoe many times to copy something is always set to whatever is in "C2".

Sub rangecopy()
    Dim source As Worksheet
    Dim destination As Worksheet
    Dim i As Integer, n As Integer
    Dim intHowmany As Integer

    Set source = Sheets("Sheet1")
    Set destination = Sheets("Sheet3")
    n = Sheets("Sheet1").Range("c2") 'number of times to be copied

    Range("a2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, (Selection.Offset(0, 1))).Select

    Selection.Copy

    intHowmany = Selection.Rows.Count

    destination.Select
    Range("a2").Select

    For i = 1 To n
        ActiveSheet.Paste
        ActiveCell.Offset(intHowmany, 0).Select
    Next i
End Sub

Upvotes: 2

Views: 786

Answers (2)

brettdj
brettdj

Reputation: 55682

You can do it quickly using arrays

This assumes your headers are in row 1, data in columns A:C

Sub Update()
Dim X
Dim Y
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long

Set ws = Sheets(1)
Set ws2 = Sheets(2)

X = ws.Range(ws.[a1], ws.Cells(Rows.Count, "C").End(xlUp))

ReDim Y(1 To 2, 1 To Application.Sum(ws.Range("B:B")) + 1)

Y(1, 1) = X(1, 1)
Y(2, 1) = X(1, 2)

lngCnt3 = 1

For lngCnt = 2 To UBound(X, 1)
    For lngCnt2 = 1 To X(lngCnt, 2)
        lngCnt3 = lngCnt3 + 1
        Y(1, lngCnt3) = X(lngCnt, 1)
        Y(2, lngCnt3) = X(lngCnt, 2)
    Next
Next

ws2.[a1].Resize(UBound(Y, 2), UBound(Y, 1)) = Application.Transpose(Y)

End Sub

Upvotes: 1

Captain Grumpy
Captain Grumpy

Reputation: 520

Not very elegant but works ok and able to be changed easy enough.

Sub rangecopy()
    Dim source As Worksheet
    Dim destination As Worksheet
    Dim i As Integer, n As Integer
    Dim intHowmany As Integer

    Set source = Sheets("Sheet1")
    Set destination = Sheets("Sheet2")
    destination.Cells(1, 1).Value = "Company"
    destination.Cells(1, 2).Value = "ID"
    startRow = 2
    usedRowsSrc = source.UsedRange.Rows.Count
    For i = startRow To usedRowsSrc
      strCompany = source.Cells(i, 1).Value
      strID = source.Cells(i, 2).Value
      iTimes = source.Cells(i, 3).Value

      For j = 1 To iTimes
        usedRowsDest = destination.UsedRange.Rows.Count
        With destination
          .Cells(usedRowsDest + 1, 1).Value = strCompany
          .Cells(usedRowsDest + 1, 2).Value = strID
        End With
      Next

    Next

End Sub

Upvotes: 2

Related Questions