Question

下面的代码复制数据（Associate Entry named range）并将其粘贴到另一个工作表（AssociateData）中的特定行号（1RecRow）。

我希望将行粘贴到编号行旁边的所有行。

要记住以下几点： A.数据被过滤，我希望粘贴在过滤后的视图中影响“1 RecRow”以下的行（不是ALL - 未过滤 - 数据）。 B.如果有帮助，如果“1 RecRow”为23，则数据以某种方式排序，然后下一行为24,25,26,27（按顺序）。

所以手动我会这样做：将数据粘贴到特定行，再从1 RecRow复制数据， Ctrl + Shift + 向下箭头和粘贴。我只是不确定如何调整代码以便它执行它。

由于

Sub UpdateLogRecord()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim lRec As Long
    Dim oCol As Long
    Dim lRecRow As Long

    Dim myCopy As Range
    Dim myTest As Range

    Dim lRsp As Long

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

    'check for duplicate order ID in database
    If inputWks.Range("CheckAssNo") = False Then
      lRsp = MsgBox("Order ID not in database. Add record?", vbQuestion + vbYesNo, "New Order ID")
      If lRsp = vbYes Then
        UpdateLogWorksheet
      Else
        MsgBox "Please select Order ID that is in the database."
      End If

    Else

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

      lRec = inputWks.Range("CurrRec").Value
      lRecRow = lRec + 1

      With inputWks
          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
          With .Cells(lRecRow, "A")
              .Value = Now
              .NumberFormat = "mm/dd/yyyy hh:mm:ss"
          End With
          .Cells(lRecRow, "B").Value = Application.UserName

          myCopy.Copy
          .Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
          Application.CutCopyMode = False
      End With      

      'clear input cells that contain constants
      ClearDataEntry
  End If

End Sub

Answer 1

尝试一下......你会指定可见的单元格不会覆盖隐藏的项目。

Dim LR As Long
    LR = Cells(Sheets("AssociateData").Rows.Count, 1).End(xlUp).Row

      myCopy.Copy
      .Range(Cells(lRecRow, 3), Cells(LR,3)).SpecialCells(xlCellTypeVisible).PasteSpecial xlValues
      Application.CutCopyMode = False

应粘贴定义的范围。我认为它会比FillDown更好......看起来像是：

.Range(Cells(lRecRow, 3),Cells(LR,3)).FillDown

如果你想要填充，你可以在粘贴价值/公式后直接将其填入。

粘贴到多行而不是单行

1 个答案: