Have search function need help editing - vba

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