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

 

[AntMac]

It's definitely possible with Macros. I'll just get started because I think we need to see your data to have the firm final answer. But to start you would right click on the worksheet name for the worksheet it's on and select view Code. In the macro window that pops up start with the code below.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range


' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("F30")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then


Select Case Target.Value
Case 1
Case Else
'we will put the code here for the copy paste
MsgBox "Cell " & Target.Address & " has changed."
End Select


End If
End Sub

 

[AntMac]

I'm thinking the next thing we need to do is find out how to find the end of your data and find the next row. Which you might have given us row 51 as the first answer, but we need to be able to have the macro do this or hard code it based on the exact same number of rows everytime. Which is a very last and reluctant way of doing it. So, what would be good is if we can get a view of your data and if one of the columns will always be populated.

 

[My Aswer Is This]

Assuming there will always be values in column F:
Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

The script will run any time you enter a value in Range("F30")

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 5/16/18 6:25 PM EDT
If Not Intersect(Target, Range("F30")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Dim ans As Long
ans = Target.Value

    For i = 1 To ans
        Lastrow = Cells(Rows.Count, "F").End(xlUp).Row + 1
        Rows(40).Resize(12).Copy Rows(Lastrow)
    Next
End If
End Sub

 

[Lindsay0385]

Assuming there will always be values in column F:
Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

The script will run any time you enter a value in Range("F30")

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 5/16/18 6:25 PM EDT
If Not Intersect(Target, Range("F30")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Dim ans As Long
ans = Target.Value

    For i = 1 To ans
        Lastrow = Cells(Rows.Count, "F").End(xlUp).Row + 1
        Rows(40).Resize(12).Copy Rows(Lastrow)
    Next
End If
End Sub

Thank you! This almost works perfectly. I made column A have values in the area I wanted to copy, and updated this line to:

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

The only problem is that when 1 is entered, it copies the selection, when I rather nothing happen. And when I enter 2, it copies twice, instead of once. And 3 copies three times instead of twice, etc.

How would I update the macro?

 

[Lindsay0385]

I'm thinking the next thing we need to do is find out how to find the end of your data and find the next row. Which you might have given us row 51 as the first answer, but we need to be able to have the macro do this or hard code it based on the exact same number of rows everytime. Which is a very last and reluctant way of doing it. So, what would be good is if we can get a view of your data and if one of the columns will always be populated.

Hi - Thank you for your help! Column A is now empty except for values in the cells that I want to copy. I entered "X" in A40 through A51, to signify the rows to copy.

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Target.Address = "$F$30" Then Exit Sub
If Target.Value > 1 Then
   Application.EnableEvents = False
   Rows("40:51").Copy Range("A52").Resize(1 * Target.Value - 1)
   Application.EnableEvents = True
End If
End Sub

 

[Lindsay0385]

Thank you! This almost works perfectly. I made column A have values in the area I wanted to copy, and updated this line to:

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1

The only problem is that when 1 is entered, it copies the selection, when I rather nothing happen. And when I enter 2, it copies twice, instead of once. And 3 copies three times instead of twice, etc.

How would I update the macro?

I figured it out, I changed the line

ans = Target.Value

to

ans = Target.Value - 1

and it seems to work. Would there be a way to "reset" the copied areas if they change the value in cell F30? So if originally they enter 3 (rows copied twice), but then change it to 4, it currently ends up with three more copied areas for a total of 5, instead of just three. Is that possible?

 

[Lindsay0385]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Target.Address = "$F$30" Then Exit Sub
If Target.Value > 1 Then
   Application.EnableEvents = False
   Rows("40:51").Copy Range("A52").Resize(1 * Target.Value - 1)
   Application.EnableEvents = True
End If
End Sub

This one worked the first time I tried it, but if I changed the value in cell F30, nothing happened. Then when I tried it again from scratch on a copy of the spreadsheet now nothing happens at all. I appreciate your help though!

I also just realized the data doesn't insert new rows in either macro, but instead replaces over values below row 51. How would I update it to insert the copied rows instead?

 

[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
                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