Copying a row based on a integer in a cell Solved/Closed

Question

Hello, 
I am needing help making a macro that will allow me to do a number of things, that may or may not be able to be done with one single macro. ( hopefully 1 macro) if not possible thats okay. 
1: I need to be able to copy a row X amount of times based on a number in a cell. ( Column 7), But when it copies based on that value i need column 4 to say Pieces. When i copy the row based on the cell value in column 10, i need column 4 to say Skids for each copied row. 
2: When copying the row i need the copied rows to ignore column 8 entirely or when the column is copied with the row it has a value of 0.
 I will be needing to do this action for various amounts of rows depending on the day, it wont be the same every time.

I had found this VBA code, it is what i'm looking for when needing a row copied but I need to to be more specific with the above alterations. I need the macro to kind of work like this.

Dim xRg As Range

Dim xCRg As Range

Dim xFNum As Integer

Dim xRN As Integer

On Error Resume Next

SelectRange:

xTxt = ActiveWindow.RangeSelection.Address

Set xRg = Application.InputBox("Select the number value", "Text box", xTxt, , , , , 8)

If xRg Is Nothing Then Exit Sub

If xRg.Columns.Count > 1 Then

MsgBox "Please select single column!"

GoTo SelectRange

End If

Application.ScreenUpdating = False

For xFNum = xRg.Count To 1 Step -1

Set xCRg = xRg.Item(xFNum)

xRN = CInt(xCRg.Value) With Rows(xCRg.Row)

.Copy

.Resize(xRN).Insert

End With

Next Application.ScreenUpdating = True

End Sub


System Configuration: Windows / Chrome 98.0.4758.102

TrowaD · Answer

Hi Sheepy,

Could you show some sample data of how your data looks now and how you want it to look after runnning the code?

Best regards,
Trowa

TrowaD · Answer

Hi Sheepy,

Here is a different code for you to try:
Sub RunMe()
Dim lRow, x, y As Long
Application.ScreenUpdating = False

lRow = Range("A1").End(xlDown).Row

For x = lRow To 2 Step -1
    y = Cells(x, "J").Value
    Do
        y = y - 1
        Range(Cells(x, "A"), Cells(x, "G")).Copy
        Cells(x + 1, "A").Insert shift:=xlDown
        Range(Cells(x, "I"), Cells(x, "AB")).Copy
        Cells(x + 1, "I").Insert shift:=xlDown
        Cells(x + 1, "H").Insert shift:=xlDown
        Cells(x + 1, "D").Value = "Pallets"
    Loop Until y = 0
    
    y = Cells(x, "G").Value
    Do
        y = y - 1
        Range(Cells(x, "A"), Cells(x, "G")).Copy
        Cells(x + 1, "A").Insert shift:=xlDown
        Range(Cells(x, "I"), Cells(x, "AB")).Copy
        Cells(x + 1, "I").Insert shift:=xlDown
        Cells(x + 1, "H").Insert shift:=xlDown
    Loop Until y = 1

Next x
Application.ScreenUpdating = True
End Sub

Best regards,
Trowa

Copying a row based on a integer in a cell

2 responses

Similar discussions

Subscribe To Our Newsletter!