Have search function need help editing

Question

So I have a code I have written the first part of the code is to create a new worksheet with the headings specified. The second part of the code is meant to populate that table with certain information. The problem I am having is getting the correct bits of information to go into the correct columns. I need the code to search for the value 9.1 in column G in all worksheets within a workbook if that value is found I need it to copy this to column b in the new sheet along with the following information :

Engine Effect from Column F Same row must be pasted to Column C in the worksheet entitled FHA Part number is always located in Cell J3 this must be pasted into column D and is always the same Part Name Is Always located in C2 this must be pasted into column E and is always the same FM ID from Column B same row must be pasted to Column F in the worksheet entitled FHA Failure Mode & Cause from Column C Same row must be pasted to column G in FHA FMCN Value From Column N pasted to Column H In FHA

As It stands the code I have is

Sub createWSheetFHA()
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FHA"

    Cells(1, 2) = "FHA TABLE"
    Cells(2, 2) = "FHA Ref"
    Cells(2, 3) = "Engine Effect"
    Cells(2, 4) = "Part No"
    Cells(2, 5) = "Part Name"
    Cells(2, 6) = "FM I.D"
    Cells(2, 7) = "Failure Mode & Cause"
    Cells(2, 8) = "FMCM"
    Cells(2, 9) = "PTR"
    Cells(2, 10) = "ETR"

    Range(Cells(2, 2), Cells(2, 10)).Font.Bold = True
    Range(Cells(1, 2), Cells(1, 10)).MergeCells = True
    Range(Cells(1, 2), Cells(1, 10)).Font.Bold = True

End Sub
Sub Populate_FHA_Table_2()
    Dim wks As Excel.Worksheet, i As Integer, n As Integer
    Application.ScreenUpdating = False
    Sheets("FHA").Range("A2:" & Columns.Count & ":" & Rows.Count).Delete
    i = 1
    For Each wks In ActiveWorkbook.Worksheets
        If wks.Name <> "FHA" Then
            wks.UsedRange.AutoFilter Field:=7, Criteria1:="9.1"
            Sheets(i).Range(Sheets(i).Range("G1").Offset(1), Sheets(i).Range("B1").End(xlDown)).Copy _
                Sheets("FHA").Range("C" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("F1").Offset(1), Sheets(i).Range("D1").End(xlDown)).Copy _
                Sheets("FHA").Range("d" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("J1").Offset(1), Sheets(i).Range("E1").End(xlDown)).Copy _
                Sheets("FHA").Range("e" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("C1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("E" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("B1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("F" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("C1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("G" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("N1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("H" & Rows.Count).End(xlUp)
            wks.UsedRange.AutoFilter
        End If
    i = i + 1
    Next
    Application.ScreenUpdating = True

End Sub

Answer 1

You have some mismatches in your code (Example using 'for each wk' then accessing via an index 'i'; where they may not necessarily match)

Try something like this...

I have added in some dynamic flow control which isn't strictly needed but if and when your headers change in the future, it may be easier to have it in this form.

Likewise I have tried to add in some error handling as well

Sub Create_FHA_Sheet()
    Dim Headers() As String: Headers = _
    Split("FHA Ref,Engine Effect,Part No,Part Name,FM I.D,Failure Mode & Cause,FMCM,PTR,ETR", ",")

    If Not WorksheetExists("FHA") Then Worksheets.Add().Name = "FHA"
    Dim wsFHA As Worksheet: Set wsFHA = Sheets("FHA")
    wsFHA.Move after:=Worksheets(Worksheets.Count)
    wsFHA.Cells.Clear

    Application.ScreenUpdating = False

    With wsFHA
        For i = 0 To UBound(Headers)
            .Cells(2, i + 2) = Headers(i)
            .Columns(i + 2).EntireColumn.AutoFit
        Next i
        .Cells(1, 2) = "FHA TABLE"
        .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).MergeCells = True
        .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).HorizontalAlignment = xlCenter
        .Range(.Cells(1, 2), .Cells(2, UBound(Headers) + 2)).Font.Bold = True
    End With

    Dim RowCounter As Long: RowCounter = 3
    Dim SearchTarget As String: SearchTarget = "9.1"
    Dim SourceCell As Range, FirstAdr As String

    If Worksheets.Count > 1 Then
        For i = 1 To Worksheets.Count - 1
        With Sheets(i)
            Set SourceCell = .Columns(7).Find(SearchTarget, LookAt:=xlWhole)
            If Not SourceCell Is Nothing Then
                FirstAdr = SourceCell.Address
                Do
                    wsFHA.Cells(RowCounter, 3).Value = .Cells(SourceCell.Row, 6).Value
                    wsFHA.Cells(RowCounter, 4).Value = .Cells(3, 10).Value
                    wsFHA.Cells(RowCounter, 5).Value = .Cells(2, 3).Value
                    wsFHA.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row, 2).Value
                    wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row, 3).Value
                    wsFHA.Cells(RowCounter, 8).Value = .Cells(SourceCell.Row, 14).Value
                    Set SourceCell = .Columns(7).FindNext(SourceCell)
                    RowCounter = RowCounter + 1
                Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr
            End If
        End With
        Next i
    End If
    Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    On Error Resume Next
    WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function