Macro to copy data from one cell to a sheet based on the value of another cell

[kormonde]

Hello, I am trying to create a macro to copy data from column A in a specific sheet of a work book, to a different specific sheet in the same workbook based on the data in a column. I have links below to the workbook I am trying to do this in, and a word document with the details of what I am trying to accomplish. I don't even know where to start, so any help that can be provided would be greatly appreciated.

Goal of Macro to Copy Names
Workbook For Copying Names

Thank you!!!

Kenny

 

[mumps]

Before trying this macro, you will have to change the sheet names to match the names in row 1 of ALL ENTRIES, specially "Cloverleaf - Exh" and "Poles - Exh".

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, lCol As Long, srcWS As Worksheet, ws As Worksheet, x As Long, y As Long, rng As Range, fnd As Range
    Set srcWS = Sheets("ALL ENTRIES")
    lCol = srcWS.Cells(2, Columns.Count).End(xlToLeft).Column
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = 3 To LastRow
        For y = 2 To lCol Step 5
            With srcWS
                Set ws = Sheets(.Cells(1, y).Value)
                If WorksheetFunction.CountA(.Cells(x, y).Resize(, 5)) > 0 Then
                    For Each rng In .Cells(x, y).Resize(, 5)
                        If rng = "X" Then
                            Set fnd = ws.Rows(1).Find(.Cells(2, rng.Column).Value, LookIn:=xlValues, lookat:=xlWhole)
                            If Not fnd Is Nothing Then
                                ws.Cells(ws.Rows.Count, fnd.Column).End(xlUp).Offset(1) = .Range("A" & x)
                            End If
                        End If
                    Next rng
                End If
            End With
        Next y
    Next x
    Application.ScreenUpdating = True
End Sub

 

[kormonde]

This worked perfectly, Thank you!!!

 

[mumps]

You are very welcome.