[英]Copy and paste the row a N number of times (N based on a value in the cell)
I've read many similar threads but I still can't figure out how to adjust my code. 我已经阅读了许多类似的主题,但是仍然不知道如何调整代码。
I have a code that copies a range and pastes it ONCE in the Data tab. 我有一个代码可以复制范围并将其粘贴到“数据”选项卡中。
I would like the range to copy an number of times based on the numerical value in cell F12 of the sheet "NoOfRowsToPaste". 我希望该范围基于工作表“ NoOfRowsToPaste”的单元格F12中的数值复制多次。 What should I add to the code to perform this? 我应该在代码中添加些什么来执行此操作?
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")
oCol = 3 ' staff info is pasted on data sheet, starting in this column
'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).Offset(1, 0).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
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
'enter user name in column B
.Cells(nextRow, "B").Value = Application.UserName
'copy the data and paste onto data sheet
myCopy.Copy
.Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
ClearDataEntry
End If
End Sub
Resizing the number of rows in the target range will correctly duplicate the copied data. 调整目标范围内的行数大小将正确复制复制的数据。
n = Worksheets("NoOfRowsToPaste").Range("F12").Value
.Cells(nextRow, oCol).Resize(n).PasteSpecial Paste:=xlPasteValues, Transpose:=True
A good answer from Thomas, though if you wanted to do additional logic for different rows I'd implement a loop and build the logic in. Providing just in case. Thomas的一个很好的答案,尽管如果您想为不同的行做附加的逻辑,我会实现一个循环并在其中构建逻辑。以防万一。
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")
Dim lng As Long
Dim pasteCount As Long
pasteCount = Worksheets("NoOfRowsToPaste").Cells(12, 6)
oCol = 3 ' staff info is pasted on data sheet, starting in this column
'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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.