Kopieren Sie einen bestimmten Bereich und fügen Sie ihn auf ein Blatt

Question

Der Code unten gut abgesehen von dem spezifischen Element funktioniert:

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

ich eine Reihe von Zellen zu kopieren versuche (A14 und eine bestimmte Anzahl (n) von Zellen oberhalb dieser Zelle) aus dem RowsToPaste-Blatt und fügen Sie diesen Bereich in das Eingabeblatt bis zur letzten Zelle in der Zeile der Spalte D ein (so dass die letzte Zeile in Spalte D A14-Werte hat, die zweitletzte wird A13-Wert usw.)

Dank

FULL CODE:

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

wenn Sie Zelle "A14" undpasteCount mehr Zellen darüber haben zu kopieren:

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

wenn Sie pasteCount Zellen ausgehend von "kopieren A14 "aufwärts:

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

Answer 2

Gerade einen offensichtlichen Fehler bemerkt. Fix it und versuchen Sie es erneut ::

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