VBA Code Problem Pulling Information to Summary Sheet

[Lexi7]

Hi Everyone,
I've read a lot of different posts online about copying certain cells and have been able to adapt some suggested solutions to solve my issue. I’m new to VBA and I’ve probably not defined something correctly in the code I’m using. I'm trying to pull cell D2 from every page in the workbook and copy it to column C on the Index page to the corresponding company in column A. In every D2 cell I have a formula that looks for the last action concerning that company (ex. called, office visit, job visit, upcoming job on __, etc.) so I need the macro to copy the value which may be a mix of text & numbers. I'd also like it to update automatically without having to run the macro each time.

The code works in that the information in cell D2 will appear in column C, but it does not match the correct company and also copies down rows without companies. I’d really appreciate any suggestions anyone has!! Thanks for taking the time to read this!

Code I’m using to copy cells D2 to the Index Page:

Sub CopyLastAction()

   Dim X As Integer
   For X = 1 To 350
      
      Sheets("Index").Cells(Rows.Count,  "C").End(xlUp)(2).Resize(Sheets(X).Range("D2").Cells.Count).Value =  Sheets(X).Range("D2").Value
      
    Next X

End Sub

I’m not sure how relevant this is, but I am using other macros in the workbook. The purpose for the workbook is for the company's salesmen to record notes about their customers & prospective customers. On one sheet the salesmen will list New Customers and select a macro button which copies an existing template & renames the sheet.
Here’s the code I’m using for that:

Sub CreateSheetsFromAList()
    Dim MyCell As Range, MyRange As Range
    Dim Sh As Worksheet, flg As Boolean
    Set MyRange = Sheets("Add New Customers").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    For Each MyCell In MyRange
        If IsEmpty(MyCell) Then
            Exit For
        End If
        flg = False
        For Each Sh In Worksheets
            If Sh.Name = MyCell.Value Then
                flg = True
                Exit For
            End If
        Next
        If flg = False Then
            Sheets("Blank Company").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Name = MyCell.Value 'renames the worksheet
            Range("A2").Value = ActiveSheet.Name
        End If
    Next MyCell

End Sub

The Index sheet shows all the customers in Column A, Last Updated date in Column B, and I'd like the last Action Performed to appear in Column C. The Index sheet also has a macro that shows the date stamp in Cell F2 and links back to the Index sheet in A1.
Here’s the code for the Index Sheet: (Thank You JoeMo once again!)

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim N As Integer
Dim calcState As Long, scrUpdateState As Long
Dim LastCellChanged As String
calcState = Application.Calculation
Application.Calculation = xlCalculationManual
scrUpdateState = Application.ScreenUpdating
Application.ScreenUpdating = False
N = 1

    With Me
        .Columns(1).ClearContents
        .Cells(1, 1) = "INDEX"
        .Cells(1, 1).Name = "Index"
        .Cells(1, 2).Value = "Last Updated"
        .Cells(1, 3).Value = "Last Action"
    End With
    
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name Then
            LastCellChanged = wSheet.Range("F2").Value
            N = N + 1
                With wSheet
                    .Range("A1").Name = "Start_" & wSheet.Index   'Change return link cell to suit here and next line
                    .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                    SubAddress:="Index", TextToDisplay:="Index"
                End With
                
                Me.Hyperlinks.Add Anchor:=Me.Cells(N, 1), Address:="", _
                SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
                Me.Cells(N, 2).Value = LastCellChanged
        End If
        
    Next wSheet
           
Me.Columns("A:C").AutoFit
Rows("1:1").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
Application.Calculation = calcState
Application.ScreenUpdating = scrUpdateState
End Sub

If anyone has any ideas, I’d really appreciate hearing them! Sorry if I put too much info here, I just didn't want to waste anyone's time if their suggestions might conflict with the existing code or if it's possible to adjust the existing code (I haven't had any success but I'm probably doing something wrong). If you're still reading this, thanks for your time!