Question

我已经阅读了很多类似的帖子，但我仍然无法弄清楚如何调整代码。

我有一个复制范围的代码，并将其粘贴到数据选项卡中。

我希望该范围基于工作表的单元格F12中的数值复制n次＆＃34; NoOfRowsToPaste＆＃34;。我应该在代码中添加什么来执行此操作？

Sub UpdateLogWorksheet()

        Dim historyWks As Worksheet
        Dim inputWks As Worksheet

        Dim nextRow As Long
        Dim oCol As Long

        Dim myCopy As Range
        Dim myTest As Range

        Dim lRsp As Long

        Set inputWks = Worksheets("Input")
        Set historyWks = Worksheets("Data")
        oCol = 3 ' staff info is pasted on data sheet, starting in this column

        'check for duplicate staff number in database
        If inputWks.Range("CheckAssNo") = True Then
          lRsp = MsgBox("Order ID already in database. Update record?", vbQuestion + vbYesNo, "Duplicate ID")
          If lRsp = vbYes Then
            UpdateLogRecord
          Else
            MsgBox "Please change Order ID to a unique number."
          End If

        Else

          'cells to copy from Input sheet - some contain formulas
          Set myCopy = inputWks.Range("Entry")

          With historyWks
              nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
          End With

          With inputWks
              'mandatory fields are tested in hidden column
              Set myTest = myCopy.Offset(0, 2)

              If Application.Count(myTest) > 0 Then
                  MsgBox "Please fill in all the cells!"
                  Exit Sub
              End If
          End With

          With historyWks
              'enter date and time stamp in record
              With .Cells(nextRow, "A")
                  .Value = Now
                  .NumberFormat = "mm/dd/yyyy hh:mm:ss"
              End With
              'enter user name in column B
              .Cells(nextRow, "B").Value = Application.UserName
              'copy the data and paste onto data sheet
              myCopy.Copy
              .Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
              Application.CutCopyMode = False
          End With

          'clear input cells that contain constants
          ClearDataEntry
      End If

    End Sub

Answer 1

调整目标范围内的行数将正确复制复制的数据。

n = Worksheets("NoOfRowsToPaste").Range("F12").Value
.Cells(nextRow, oCol).Resize(n).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Answer 2

Thomas的一个很好的答案，但是如果你想为不同的行做额外的逻辑我会实现一个循环并构建逻辑。提供以防万一。

Sub UpdateLogWorksheet()

        Dim historyWks As Worksheet
        Dim inputWks As Worksheet

        Dim nextRow As Long
        Dim oCol As Long

        Dim myCopy As Range
        Dim myTest As Range

        Dim lRsp As Long

        Set inputWks = Worksheets("Input")
        Set historyWks = Worksheets("Data")

        Dim lng As Long
        Dim pasteCount As Long
        pasteCount = Worksheets("NoOfRowsToPaste").Cells(12, 6)

        oCol = 3 ' staff info is pasted on data sheet, starting in this column

        'check for duplicate staff number in database
        If inputWks.Range("CheckAssNo") = True Then
          lRsp = MsgBox("Order ID already in database. Update record?", vbQuestion + vbYesNo, "Duplicate ID")
          If lRsp = vbYes Then
            UpdateLogRecord
          Else
            MsgBox "Please change Order ID to a unique number."
          End If

        Else

          'cells to copy from Input sheet - some contain formulas
          Set myCopy = inputWks.Range("Entry")

          With historyWks
              nextRow = .Cells(.Rows.Count, "A").End(xlUp).Row
          End With

          With inputWks
              'mandatory fields are tested in hidden column
              Set myTest = myCopy.Offset(0, 2)

              If Application.Count(myTest) > 0 Then
                  MsgBox "Please fill in all the cells!"
                  Exit Sub
              End If
          End With

        With historyWks
            'enter date and time stamp in record
            For lng = 1 To pasteCount
                With .Cells(nextRow + lng, "A")
                    .Value = Now
                    .NumberFormat = "mm/dd/yyyy hh:mm:ss"
                End With
                'enter user name in column B
                .Cells(nextRow + lng, "B").Value = Application.UserName
                'copy the data and paste onto data sheet
                myCopy.Copy
                .Cells(nextRow + lng, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            Next lng
            Application.CutCopyMode = False
        End With

          'clear input cells that contain constants
          ClearDataEntry
      End If

    End Sub

将行复制并粘贴N次（N基于单元格中的值）

2 个答案: