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". 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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.