Copy a row per the QTY Value

[Evapar18]

So I am trying to do this code at the end of the "Button click". If the QTY.value is > 1 then I need it to copy the data that has already been inputted in the spreadsheet = to the X QTY.

If possible I would like the Dimension# stay put and no changes to it.

https://goo.gl/HWRn9T

Per the image, I just want to copy Range B through G per the QTY, minus the first one, so 3 more times. other than the "If" statement above that's is as far as I got. I searched the web found a few selections but nothing I found worked exactly the way I was needing.

I plan to clear all the values after this and add more dimensions.

Thanks,
SB

 

[Fluff]

Maybe something like

Range("B3:G3").Copy Range("B4:G4").Resize(1 * (Range("H3") - 1))

 

[Evapar18]

Thanks that's closer than what I had, but I keep getting a Runtime error 1004.

I guess I should have pointed out is that the row is dynamic and changing per each dimension that is added. So it's not in a dedicated cell every time.

 

[Fluff]

What code are you using to add the details to the row?

 

[Evapar18]

It's not written very well, but it works except for this part.

Private Sub Add_Dim_Click()

dst = DSub.Value
n = Nominal.Value
u = Units
q = QTY


Dim rw As Long 'next available row


If TextBox1.Enabled And TextBox2.Enabled Then


    With Sheets("Sheet1")
    
    rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    
    .Range("C" & rw) = n
    .Range("Q" & rw) = TextBox1 'Max Tolerance
    .Range("P" & rw) = TextBox2 'Min Tolerance
    .Range("E" & rw).FormulaR1C1 = "=RC[-2]-RC[11]" 'Min Tolerance
    .Range("F" & rw).FormulaR1C1 = "=RC[-3]+RC[11]" 'Max Tolerance
    
    
    End With
    
ElseIf TextBox3 = Enabled And TextBox4 = Enabled Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("F" & rw) = TextBox4
        .Range("E" & rw) = TextBox3
    
        End With
 
ElseIf Sym = Enabled And StdT = "ANGULAR" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw).Value = Sym
        .Range("F" & rw).FormulaR1C1 = "=RC[-3]+RC[-2]" 'Min Tolerance
        .Range("E" & rw).FormulaR1C1 = "=RC[-2]-RC[-1]" 'Max Tolerance
        
         End With


ElseIf Sym = Enabled And StdT = "2 PLC DEC" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw).Value = Sym
       
        
         End With


ElseIf Sym = Enabled And StdT = "3 PLC DEC" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw).Value = Sym
        
         End With
         
         
ElseIf Sym = Enabled Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw) = Sym
        
         End With


ElseIf DSub = "Text" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    
        .Range("C" & rw) = n
        
         End With


End If
 
   With Sheets("Sheet1")
 
      'get the next avialable row in Sheet1
      rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
 
      'put the text box values in this row
      .Range("B" & rw) = dst
      '.Range("C" & rw) = n
      .Range("G" & rw) = u
      .Range("H" & rw) = q
      
      
   
   End With
 


       If QTY.Value > 1 Then
 
             Range("B3:G3").Copy Range("B4:G4").Resize(1 * (Range("H3") - 1))
 
 
 
        End If




   '================================
   'OPTIONAL - clear the text boxes
   '================================
   DSub.Value = ""
   Nominal.Value = ""
   Tol_type.Value = ""
   TextBox1.Value = ""
   TextBox2.Value = ""
   TextBox3.Value = ""
   TextBox4.Value = ""
   Sym.Value = ""
   StdT.Value = ""
   
   'QTY.Value = ""
   
  
End Sub

 

[Fluff]

Ok, try

If Qty.Value > 1 Then
   With Sheets("sheet1")
      .Range("B" & Rw).Resize(, 6).Copy Range("B" & Rw + 1).Resize(1 * (CLng(Qty) - 1), 6)
   End With
End If

 

[Evapar18]

That works perfectly! Thanks so much, I truly appreciate it.

May God Bless you!
SB

 

[Fluff]

Glad to help & thanks for the feedback