VBA复制和粘贴循环(生成字段号)

现在我正在努力生成一个基于数量在Excel中的标签。 我设法得到它根据从单元格的价值复制和粘贴。 但是,我不知道如何根据循环改变一些细胞。

下面是一个例子:

当前结果:

| A | B | C | D | E | |------------------------------- |----- |-------------------- |----- |----- | | NMB IN DIA | | MADE IN THAILAND | | | | INVOICE NO | : | MM035639 | | | | C/NO | : | 1 | / | 2 | | SHIP TO | : | A | | | | QTY | : | 100 | | | | NMB PARTS NO | : | SFASDF234 | | | | | | *SFASDF234* | | | | CUST PARTS NO | : | SFASDF234 | | | | CUST ORDER NO | : | | | | | ----------------------------- | --- | ------------------ | --- | --- | | NMB IN DIA | | MADE IN THAILAND | | | | INVOICE NO | : | MM035639 | | | | C/NO | : | 1 | / | 2 | | SHIP TO | : | A | | | | QTY | : | 100 | | | | NMB PARTS NO | : | SFASDF234 | | | | | | *SFASDF234* | | | | CUST PARTS NO | : | | | | | CUST ORDES NO | : | | | | 

预期结果 :

 | A | B | C | D | E | |------------------------------- |----- |-------------------- |----- |----- | | NMB IN DIA | | MADE IN THAILAND | | | | INVOICE NO | : | MM035639 | | | | C/NO | : | 1 | / | 2 | | SHIP TO | : | A | | | | QTY | : | 100 | | | | NMB PARTS NO | : | SFASDF234 | | | | | | *SFASDF234* | | | | CUST PARTS NO | : | SFASDF234 | | | | CUST ORDER NO | : | | | | | ----------------------------- | --- | ------------------ | --- | --- | | NMB IN DIA | | MADE IN THAILAND | | | | INVOICE NO | : | MM035639 | | | | C/NO | : | 2 | / | 2 | | SHIP TO | : | A | | | | QTY | : | 100 | | | | NMB PARTS NO | : | SFASDF234 | | | | | | *SFASDF234* | | | | CUST PARTS NO | : | | | | | CUST ORDES NO | : | | | | 

正如你所看到的预期的结果,C / No是基于数量的循环。 不只是复制粘贴。 有什么我可以补充吗?

以下是我目前的代码:

 Private Sub CommandButton1_Click() Dim i As Long For i = 2 To Worksheets("Sheet3").Range("E3").Value Range("A1:A9", Range("E9")).Copy Sheet3.Range("A65536").End(xlUp)(2) Next i End Sub 

只需将相关单元格的值设置为i

 Private Sub CommandButton1_Click() Dim i As Long Dim NewLoc As Range For i = 2 To Worksheets("Sheet3").Range("E3").Value 'Decide where to copy the output to Set NewLoc = Sheet3.Cells(Sheet3.Rows.Count, "A").End(xlUp).OffSet(1, 0) 'Copy the range Range("A1:E9").Copy NewLoc 'Change the value of the cell 2 rows down and 2 rows to the right NewLoc.Offset(2, 2).Value = i Next i End Sub