Copy Select Cells From Row To New Sheet IF Specific Column Contains "Y"

[SavantE]

Hello all!

I'm brand new to the forum and hoping for a solution to the following complex situation.

I have a workbook with 24 sheets. I am hoping to make a 25th sheet that accesses the other 24 in the following way...I will call the 25th sheet MASTER for script purposes.

I am adding a column M to each sheet. I want a macro/VBA so that any time the letter Y (for yes) is entered into column M in the rows of the first 24 sheets, it will create a new row in MASTER and copy the values in cells B, C, D, H, and J from the regular sheet's row into the MASTER sheet's new row. The cell values should transfer as follows from regular sheets to the master.

B > B, C > C, D > D, J > E, H >F.

If in the newly created row in MASTER, the value of cell A could be the name of the sheet it is pulling from, that would also be helpful.

So example where sheet 7 (of 24) is named CHOLULA.

In CHOLULA column M, I enter "Y" on row 2.
Then, a new row is generated in MASTER, taking the values from cells B2, C2, D2, J2, and H2 from CHOLULA row 2 and copying them over to the new row in MASTER, as well as filling MASTER cell A2 with the name of sheet 7, CHOLULA.

Is this possible? Would anyone have a script that would work for this? It would be greatly appreciated as this has been giving me a headache at work since I'm of a fairly novice skill level Excel wise.

 

[johnnyL]

I think the following will handle all of your requests:

Option Compare Text                             ' Removes Case Sensitivity

Sub Worksheet_Change(ByVal Target As Range)
'
    Dim LastRowInMasterSheetPlus1   As Long
    Dim RowThatChanged              As Long
    Dim NameOfSheetChanged          As String
    Dim NameOfMasterSheet           As String
'
    NameOfMasterSheet = "Master"                                                                                    ' <--- Set this to the name of the Master sheet
'
    On Error GoTo CellDeletionErrorHandler
'
    If Not (Intersect(Target, Range("M1:M" & Range("M" & Rows.Count).End(xlUp).Row)) Is Nothing) And (Target = "Y") Then
'
        LastRowInMasterSheetPlus1 = Sheets("Master").Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row + 1      ' Get Row Number + 1
               NameOfSheetChanged = ActiveSheet.Name                                                                    ' Save the Sheet Name that was changed
                   RowThatChanged = Target.Row                                                                          ' Save the row value that had a 'Y' entered in column M
'
'                                                                                                                       ' Copy values over to Master sheet
        Sheets(NameOfMasterSheet).Range("A" & LastRowInMasterSheetPlus1 & ":F" & LastRowInMasterSheetPlus1) = _
            Array(NameOfSheetChanged, ActiveSheet.Range("B" & RowThatChanged), ActiveSheet.Range("C" & RowThatChanged), _
                ActiveSheet.Range("D" & RowThatChanged), ActiveSheet.Range("J" & RowThatChanged), ActiveSheet.Range("H" & RowThatChanged))
    End If
'
    Exit Sub
'
CellDeletionErrorHandler:
    If Err.Number = 13 Then
        Err.Clear
        Exit Sub
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
End Sub

Copy that code into each sheet in the workbook with the exception of the 'Master' sheet and let us know how it works for you,

The code will append a line to the 'Master' sheet each time a 'y' is entered into Column M.

 

[SavantE]

This worked absolutely perfectly. I added an application update = false line so as not to break workflow but color me impressed. Thank you so much!!!

 

[johnnyL]

You are welcome, I'm glad it worked for you @SavantE.