C/P data row from sheet1 to sheet2 or 3 based on cell criteria VBA

[Karley]

Hello -

Desired use case:
- Copy row data in sheet 1 (col A-E)
- Find last blank row in 'region' sheets 2,3&4
- Paste row data from sheet 1 into designated sheet based on value input in cell F4
EX: If region is 'Canada', copy cells A-E (Group-LOI) and paste data items in the Canada sheet.
Note: Column headers are the exact same and in the same order across all sheets.

Any help on the above would be greatly appreciated. I've spent too much time trying to figure it out that I may be overthinking. Thank you in advance.

 

[cmowla]

I know you mentioned which row you want to paste on, but I assume it's also columns A-E in the region sheets? If so (and if not, this code can be easily modified to make it however it should be),

[0] Make a copy of your Workbook before you do any of this!

[1] Right click on the Maturity Assessment sheet tab and click View Code:

[2] Copy and paste the following code into the window that pops up.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$4" Then
    Call Copy_And_Paste_To_Sheet("Maturity Assessment", Range("F4").Value)
End If
End Sub

[3] Now in a standard code module

Copy the following code to any of them (or make a new one)

Sub Copy_And_Paste_To_Sheet(sourceSheetName As String, destinationSheetName As String)

Dim numberOfRowsToCopy As Long
With Sheets(sourceSheetName)
    numberOfRowsToCopy = .Cells(.Rows.Count, 1).End(xlUp).Row - 5 + 1  'Assumes that
    '5 is the first data row of source sheet (as shown in picture)!
End With

Dim previousCalculation As Variant
previousCalculation = Application.Calculation
Application.Calculation = xlCalculationManual
With Sheets(destinationSheetName)
    Dim pasteRow As Long
    pasteRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

    .Range("A" & pasteRow & ":" & "E" & pasteRow + numberOfRowsToCopy - 1).Value = _
    Sheets(sourceSheetName).Range("A5:E" & numberOfRowsToCopy + 5 - 1).Value
End With
Application.Calculation = previousCalculation

End Sub

[4] Change the Dropdown in Sheet Maturity Assessment and see what happens.

Notes:

• This code assumes that you will have new/fresh data in sheet Maturity Assessment upon each data transfer (starting on row 5, which I assume is the first data row of the sheet).
  
  
• It assumes that the paste columns are Columns A-E.
  
  
• It will only paste values (not formatting).
  
  
• And it will just paste the new data in the region sheet from where it last left off (row-wise).

Let us know if this is what you want.

 

[Karley]

@cmowla Absolutely amazing! Worked seamlessly due to your support and thorough instructions.
Can I ask that a button be created for use instead of command enter? Based on human error, would rather data values but inputted and a button be pressed to trigger the copy/paste and be used as validation of successful entry. How might I go about that using what you already provided?

 

[cmowla]

I really appreciate the gratitude. I don't receive this from most.

Creating a button can be a sophisticated process. So below is code that will create one for you (and in a place that you might like it to be created). So
[1] Copy this code to the standard code module where you have put previous code (not the code that's in the sheet itself . . . where the actual copy subroutine is). The place where you put:

Sub Copy_And_Paste_To_Sheet(sourceSheetName As String, destinationSheetName As String)

For simplicity, put the code above it.

Sub Test__Create_Button()
Call Create_Button("Maturity Assessment", "G3:G4", "Test__Copy_And_Paste_To_Sheet")
End Sub
Sub Create_Button(sheetName As String, cellAddress As String, macroNameToRun As String)

Sheets(sheetName).Buttons.Delete

With Sheets(sheetName).Range(cellAddress)
    Dim btn As Button
    Set btn = Sheets(sheetName).Buttons.Add(.Left, .Top, .Width, .Height)
End With

With btn
    .Font.Size = 12
    .Font.Bold = False
    .Font.Name = "Calibri"
    .OnAction = macroNameToRun
    .Caption = "Copy"
    .Name = "Copy Button"
End With

End Sub
Sub Test__Copy_And_Paste_To_Sheet()
Call Copy_And_Paste_To_Sheet("Maturity Assessment", Sheets("Maturity Assessment").Range("F4").Value)
End Sub

[2] Remove/delete (or comment it all out by selecting all with Ctrl A and pressing this button at the top of the VBA code window

the code that's in the sheet itself:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$4" Then
Call Copy_And_Paste_To_Sheet("Maturity Assessment", Range("F4").Value)
End If
End Sub

All you have to do is (in the code window where this code is):

Sub Test__Create_Button()
Call Create_Button("Maturity Assessment", "G3:G4", "Test__Copy_And_Paste_To_Sheet")
End Sub

Left click on any of the above (3 lines of) code (preferably the middle line), and then click on the green Run/Play button.

A button like this should now be next to the drop-down.

• If you would like to color it, it's not possible from this simple process to make a button. You should probably start another thread/topic on that, as I have little experience with that. (I actually prefer to use cells as buttons. Double clicking on a cell or right clicking on one to trigger a macro to run.)
  
  
• If you would like to rename the button, you can simply find the text "Copy" in the code I just gave you. That's the "Caption" in this code segment (of which you can make other obvious changes to the look of the font).

With btn
    .Font.Size = 12
    .Font.Bold = False
    .Font.Name = "Calibri"
    .OnAction = macroNameToRun
    .Caption = "Copy"
    .Name = "Copy Button"
End With

If at any time you would like to delete the button, just right click on it and select cut. You can always do the same thing (run this program to recreate it).

 

[Karley]

Easy peasy!! I'm sorry to say, but I think it took me less time to execute than it did for you to outline - it's an added bonus when you present it in a way that can be applied in one shot! You certainly saved me days/hours and for that, I am grateful!!
No interest in adding makeup to the button, how it is now is perfectly acceptable.
Thank you again, I'll remember you! Have a great weekend!

 

[cmowla]

And you have a great weekend as well!