[英]Copy a specified range and paste to a sheet
The code below works well apart from the specific element: 下面的代码除了特定的元素外还可以很好地工作:
rowstopasteperiodsWks.Range(("A14"), ActiveCell.Offset(-pasteCount, 0)).Copy_
Destination:=Worksheets("Input").Range(LastRowPeriod,Offset(-pasteCount,0))
I am trying to copy a range of cells (A14 and a specified (n) number of cells above this cell) from the RowsToPaste sheet and paste this range to the Input sheet to the last cell in the row of column D (so that the last row in column D will have A14 values, th second last will have A13 value etc.) 我正在尝试从RowsToPaste工作表中复制一定范围的单元格(A14和此单元格上方指定的(n)个单元格),并将此范围粘贴到Input表中到D列中的最后一个单元格(以便D列的最后一行将具有A14值,倒数第二个将具有A13值,依此类推)
Thanks 谢谢
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
Just noticed one obvious error. 刚注意到一个明显的错误。 Fix it and try again::
修复它,然后重试::
rowstopasteperiodsWks.Range(("A14"), ActiveCell.Offset(pasteCount*-1, 0)).Copy_
Destination:=Worksheets("Input").Range(LastRowPeriod,Offset(pasteCount*-1,0))
if you have to copy cell "A14" and pasteCount
more cells above it: 如果必须复制单元格“ A14” 并
pasteCount
在其pasteCount
其他单元格,请执行以下操作:
rowstopasteperiodsWks.Range("A14").Offset(-pasteCount).Resize(pasteCount + 1).Copy _
Destination:=Worksheets("Input").Cells(Rows.Count, "D").End(xlUp).Offset(1)
if you have to copy pasteCount
cells starting from "A14" upwards: 如果必须复制从“ A14”开始的
pasteCount
单元格,则:
rowstopasteperiodsWks.Range("A14").Offset(-pasteCount+1).Resize(pasteCount).Copy _
Destination:=Worksheets("Input").Cells(Rows.Count, "D").End(xlUp).Offset(1)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.