Vba “复制单元格”；"；次数&引用；"；是否由用户指定

我试图编写一个宏，它将在一张纸上查看数字用户输入，并在另一张纸上复制相同次数的内容

例如，我想复制公司名称和ID“n”次。“n”在同一行的最后一列中指定

表一 第2页 此代码执行类似的操作，但为hoe多次选择的复制某个内容的范围始终设置为“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("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

---

您可以使用数组快速完成此操作

这假设您的标题位于第1行，数据位于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

---

在我的实际工作表中，我的标题在B8、C8中，时间标题在F8中。因此，我将起始行设置为9，并将代码更改为

，以便I=startRow使用drowsrc strCompany=source.Cells（I，2）。Value strID=source.Cells（I，3）。Value iTimes=source.Cells（I，6）。Value

，但这样做会使宏无法执行它应该执行的操作。除了标题名称之外，它不会在第2页上放置任何内容。您可以手动将值分配给usedRowsSrc。或者单击最后一行类型dealio-usedRowSrc=Application.InputBox（“选择输入数据的最后一行”，类型：=8）。行在我的实际工作表中，标题在B8、C8，时间标题在F8。我把“C”改成了“F”。如何更改其余部分以适应实际信息所在的位置？我把它弄糟了，无法让它在这些地方工作

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

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

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