Transfer data from specific cell in row to different sheet

[DanSMT]

All,

I pretty much have the code together, but i'm struggling with getting the code from Sheet "Data" to sheet "FAI"

output of data from spreadsheet on "Data" tab is shown below.

Date	Part Number	Supplier	Rev	RI Code
5/3/2022​	C073061-D-F	BLABLA	D	E06
5/3/2022​	C073061-D-F	BLABLA	D	E06
5/3/2022​	C073061-D-F	BLABLA	D	E06
5/3/2022​	C073061-D-F	BLABLA	D	E06
5/3/2022​	C073061-D-F	BLABLA	D	E06

VBA Code below

'Write the recordset values in the sheet.
Worksheets("Data").Range("A2").CopyFromRecordset rs

'transfer from data tab to fai log
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Worksheets("data").Activate

'Dim cell As Range
Dim rng As Range
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim ite
Dim myDate As Date

myDate = Application.Max(Columns(1))
ActiveSheet.AutoFilterMode = False
Columns(1).AutoFilter Field:=1, Criteria1:=Format(myDate, [A2].NumberFormat)
Set shtSrc = Worksheets("Data") ' Sets "Sheet1" sheet as source sheet
Set shtDest = Worksheets("FAI") 'Sets "Sheet2." sheet as destination sheet
Set rng = Range("B2", Range("B65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
ite = Me("Part" & a)

For Each cell In rng
    If cell = ite Then
        Sheets("Data").Range("B" & rng).Value = Worksheets("FAI").Range("C4").Value
    End If
Next cell
'Close the recordset and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'loop
Next a

done2:
'Enable the screen.
Application.ScreenUpdating = True

'Inform the user that the macro was executed successfully.
MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Import successful"
Worksheets("PSW").Activate
Unload Me

'error handler
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"

The code runs properly, but I do not see the output onto the FAI sheet location C4.

 

[DanSMT]

Ok, I've made some progress on this. I am able to create the new sheet, but I'm alarming out when trying to transfer the data from the "Data" tab to the new sheet. I'm thinking this is because of the declaration of "rng", although I'm not 100% sure. Any ideas?

'Write the recordset values in the sheet.
Worksheets("Data").Range("A2").CopyFromRecordset rs

'transfer from data tab to fai log
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Worksheets("data").Activate

'Dim cell As Range
Dim rng As Range
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim ite
Dim myDate As Date

myDate = Application.Max(Columns(1))
ActiveSheet.AutoFilterMode = False
Columns(1).AutoFilter Field:=1, Criteria1:=Format(myDate, [A2].NumberFormat)
Set shtSrc = Worksheets("Data") ' Sets "Sheet1" sheet as source sheet
Set shtDest = Worksheets("FAI") 'Sets "Sheet2." sheet as destination sheet
Set rng = Range("B2", Range("B65536").End(xlUp)).SpecialCells(xlCellTypeVisible)

ite = Me("Part" & a)

For Each cell In rng

    If cell = ite Then

        Sheets("FAI").Copy after:=Sheets("Capability Study")
        ActiveSheet.Name = (ite & " - " & a)
        ActiveSheet.Range("C4").Value = Sheets("Data").Range("B" & rng).Value
    
    End If

Next cell
'Close the recordset and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'loop
Next a

done2:
'Enable the screen.
Application.ScreenUpdating = True

'Inform the user that the macro was executed successfully.
MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Import successful"
Worksheets("PSW").Activate
Unload Me

'error handler
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rs = Nothing
Set cnn = Nothing

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"

End Sub

 

[DanSMT]

It is definitely the source for the copied text that is causing the problem. Unsure how to resolve.

ActiveSheet.Range("C4").Value = Sheets("Data").Range("B" & rng).Value

I've revised to the below code to confirm i can place in the destination, but can't figure out the source part.

Sheets(ite & " - " & a).range("C4").Value = "HI"