複製指定範圍並粘貼到薄片

下面的代碼工作良好遠離特定元素：複製指定範圍並粘貼到薄片

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

我試圖複製的單元格區域（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

來源

2017-01-13 ewuchatka

，如果你要複製單元格「A14」和pasteCount多個單元格上面：

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

，如果你要複製pasteCount細胞「開始A14「向上：

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

來源

2017-01-13 16:53:47 user3598756

嘿@ user3598756，這幾乎就是我所需要的（第一個代碼），但有一個修改，第二部分（粘貼）代碼需要。我想開始粘貼我複製的東西，pasteCount在「Cells（Row.Count ，「D」）「。我需要添加什麼代碼？我認爲OFFSET不知何故到單元格位？ – ewuchatka

我認爲我已經完成了:)感謝rowstopasteperiodsWks.Range（」A14「）。Offset（-pasteCount + 1 ）.Resize（pasteCount）.Copy _ Destination：= Worksheets（「AssociateData」）。Cells（Rows.Count，「D」）。End（xlUp）.Offset（-pasteCount + 1）THANKS A LOT – ewuchatka

剛注意到一個明顯的錯誤。修復它，然後再試一次::

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

來源

2017-01-13 12:41:50 Vityata

嘿，謝謝@Vityata。「目標」行被突出顯示爲語法錯誤。任何想法爲什麼？ – ewuchatka

把它從這裏 - > http://pastebin.com/PFZGE4iM – Vityata

你好，我現在得到一個錯誤「子或功能沒有定義」，它突出顯示第一個「偏移」字。有任何想法嗎？這裏是我的代碼：http://pastebin.com/407xdQVj – ewuchatka

複製指定範圍並粘貼到薄片

回答

相關問題