如何以这种方式将数据粘贴到列和行中

我有一些标签数据要根据用户定义的输入值以列和行格式打印。它们是基于 3 个主要输入的条件：

1) 要跳过的起始标签数量 2) 每行标签数量 3) 每页行数

我有一份数据表，其中 A 列中包含数据，B 列中包含要打印的份数。我在希望打印的页面中附加了具有不同输入和输出的示例图像。还提供了可能与我的目的相关的代码链接。

数据表

打印表

我的代码限制为 3 列，行数不受限制，并且不能跳过

Here 您可以调整用户窗体的这些代码吗：使其小而高效 https://stackoverflow.com/questions/61000484/can-you-tweak-these-codes-for-userform-make-it-small-and-efficient是 @Brian M Stafford 给出的动态用户表单文本框创建的代码，但不确定如何实现此目的

Public Sub GenerateLabels()
Dim CopyRowValue As String
Dim SecondDataCol, ThirdDataCol, FirstDataCol As Long
Dim SecondDataRow, ThirdDataRow, FirstDataRow As Long

Set shdata = ThisWorkbook.Sheets("Database")
Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")

FirstDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column
SecondDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column
ThirdDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column

FirstDataRow = shgenerate.Cells(shgenerate.Rows.Count, "A").End(xlUp).Row
SecondDataRow = shgenerate.Cells(shgenerate.Rows.Count, "C").End(xlUp).Row
ThirdDataRow = shgenerate.Cells(shgenerate.Rows.Count, "E").End(xlUp).Row

'======== Copy From Data Sheet============

Last_Row = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row

For r = 2 To Last_Row  

shdata.Cells(x, "A").Copy
shDesignFormat.Range("B3").Paste 'pasting data to design sheet before print (to format data)

CopyRowValue = Worksheets("Database").Cells(r, "B").value 

For r2 = 1 To CopyRowValue 

'=====Paste to Generate Sheet ====

'Cells(FirstDataRow + 1, FirstDataCol + 1).Offset(0, 0).Select
If IsEmpty(shgenerate.Cells(FirstDataRow + 0, FirstDataCol + 0).Offset(0, 0).value) = True Then

shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(FirstDataRow + 0, FirstDataCol + 0).Offset(0, 0)

ElseIf IsEmpty(shgenerate.Cells(SecondDataRow + 0, SecondDataCol + 2).Offset(0, 0).value) = True Then 'offset used to find empty cell if design layout changed
shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(SecondDataRow + 0, SecondDataCol + 2).Offset(0, 0)

ElseIf IsEmpty(shgenerate.Cells(ThirdDataRow + 0, ThirdDataCol + 4).Offset(0, 0).value) = True Then
shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(ThirdDataRow + 0, ThirdDataCol + 4).Offset(0, 0)


SecondDataRow = SecondDataRow + 2
ThirdDataRow = ThirdDataRow + 2
FirstDataRow = FirstDataRow + 2

End If

Next r2

Next r

Application.CutCopyMode = False

End Sub

看着你的代码，我的第一个想法是它可以简化。完成此操作后，我开始修改以添加所需的要求。主要任务是跟踪当前位置。代码最终是这样的：

Option Explicit

Public Sub GenerateLabels(ByVal LabelsToSkip As Integer, ByVal LabelsPerRow As Integer, ByVal RowsPerPage As Integer)
   Dim shdata As Worksheet
   Dim shgenerate As Worksheet
   Dim shDesignFormat As Worksheet
   Dim curRow As Long
   Dim curCol As Long
   Dim RowsPerPageCount As Long
   Dim r As Long
   Dim r2 As Long

   Set shdata = ThisWorkbook.Sheets("Database")
   Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
   Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")

   shgenerate.UsedRange.ClearContents

   curRow = 1
   curCol = 1
   RowsPerPageCount = 1

   For r = 2 To shdata.Range("A" & Rows.Count).End(xlUp).Row
      '======== Copy From Data Sheet============
      shdata.Cells(r, "A").Copy
      shDesignFormat.Range("B3").PasteSpecial  'pasting data to design sheet before print (to format data)

      For r2 = 1 To shdata.Cells(r, "B").Value + LabelsToSkip
         '=====Paste to Generate Sheet ====
         If curCol > LabelsPerRow * 2 Then  '* 2 for double spacing
            curCol = 1

            If RowsPerPage > 0 And (RowsPerPageCount + 1) Mod (RowsPerPage + 1) = 0 Then
               curRow = curRow + 10  'new page
               RowsPerPageCount = 1
            Else
               curRow = curRow + 2
               RowsPerPageCount = RowsPerPageCount + 1
            End If
         End If

         If r2 > LabelsToSkip Then
            LabelsToSkip = 0
            shDesignFormat.Range("B3").Copy Destination:=shgenerate.Cells(curRow, curCol)
         End If

         curCol = curCol + 2
      Next r2
   Next r

   Application.CutCopyMode = False
End Sub

我建议使用Option Explicit并声明您需要的所有变量。