Copy and Paste Rows Based on Cell Value

[Lindsay0385]

Hi - I'm working on a spreadsheet and need help. I have Cell F30, set to be numeric data validation, specifically a number greater than or equal to 1. Here's what I'm trying to do...

If someone uses the form and enters a 1 in Cell F30, I would like nothing to be done.

If someone puts a 2 in Cell F30, I would like the spreadsheet to copy Rows 40-51 and paste once, inserting the copied rows directly below Row 51.

If someone puts a 3 in Cell F30, I would like the spreadsheet to copy Rows 40-51 and paste twice, inserting the first copied rows below Row 51, and then the next paste below that previous paste.​

And so on.​

It would be awesome, if it could automatically run as soon as a value is entered in F30, but if not, I can add a button with instructions.

Is this at all possible? Usually I start with recording a macro and then edit to my hearts desire, but I don't know how I could setup this macro via recording.

Thanks,

Lindsay

 

[Lindsay0385]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim x   As Long
    Dim LC  As Long
    
    With Target
        If .Count > 1 Then Exit Sub
        If .Value > 1 And Not Intersect(Target, Cells(30, 6)) Is Nothing Then
        
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With
            
            For x = 1 To .Value - 1
                LC = Cells(40, Columns.Count).End(xlToLeft).Column
                Cells(40, 1).Resize(12, LC).EntireRow.Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
                Application.CutCopyMode = False
            Next x
            
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            
        End If
    End With

End Sub

Thanks! This does the same as the other macro, but, like that one too, it replaces the data below row 51 instead of inserting the copied rows below row 51 (above row 52). Would there be a way to fix that?

Also, would there be a way to "reset" the copied areas if the number in the box is changed?

 

[JackDanIce]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim x   As Long
    Dim LC  As Long
    
    With Target
        If .Count > 1 Then Exit Sub
        If .Value > 1 And Not Intersect(Target, Cells(30, 6)) Is Nothing Then
        
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With
            
            For x = 1 To .Value - 1
                LC = Cells(40, Columns.Count).End(xlToLeft).Column
                With Cells(40, 1).Resize(12, LC)
                    .EntireRow.Copy
                    .Offset(.Rows.Count).EntireRow.Insert
                End With
                Application.CutCopyMode = False
            Next x
            
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            
        End If
    End With


End Sub

Also, would there be a way to "reset" the copied areas if the number in the box is changed?

Try:

[/COLOR]Sub Reset()


    Cells(52, 1).Resize(12 * Cells(30, 6).Value - 11).EntireRow.Delete


End Sub