Question

以下代码与特定元素完全相同：

rowstopasteperiodsWks.Range(("A14"), ActiveCell.Offset(-pasteCount, 0)).Copy_
      Destination:=Worksheets("Input").Range(LastRowPeriod,Offset(-pasteCount,0))

我正在尝试从RowsToPaste工作表复制一系列单元格（A14和此单元格上方指定的（n）个单元格数量），并将此范围粘贴到输入工作表到D列行中的最后一个单元格（因此，D列中的最后一行将具有A14值，第二行将具有A13值等。）

由于

完整代码：

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")
        Set rowstopasteperiodsWks = Worksheets("RowsToPaste")

        Dim lng As Long
        Dim pasteCount As Long
        pasteCount = Worksheets("RowsToPaste").Cells(2, 6)
        periodsCopy = Worksheets("RowsToPaste").Range("A12")

        LastRowPeriod = Cells(Rows.Count, 4).End(xlUp).Row
        oCol = 3 ' staff info is pasted on data sheet, starting in this column



      rowstopasteperiodsWks.Range(("A14"), ActiveCell.Offset(-pasteCount, 0)).Copy_
      Destination:=Worksheets("Input").Range(LastRowPeriod,Offset(-pasteCount,0))

        '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

Answer 1

注意到一个明显的错误。修复它并再试一次::

rowstopasteperiodsWks.Range(("A14"), ActiveCell.Offset(pasteCount*-1, 0)).Copy_
      Destination:=Worksheets("Input").Range(LastRowPeriod,Offset(pasteCount*-1,0))

Answer 2

如果你必须复制细胞＆＃34; A14＆＃34; 和 pasteCount上面有更多单元格：

rowstopasteperiodsWks.Range("A14").Offset(-pasteCount).Resize(pasteCount + 1).Copy _
  Destination:=Worksheets("Input").Cells(Rows.Count, "D").End(xlUp).Offset(1)

如果你必须从＆＃34; A14＆＃34;开始复制pasteCount个单元格向上：

rowstopasteperiodsWks.Range("A14").Offset(-pasteCount+1).Resize(pasteCount).Copy _
  Destination:=Worksheets("Input").Cells(Rows.Count, "D").End(xlUp).Offset(1)

复制指定范围并粘贴到工作表

2 个答案: