VBA to copy a cell from multiple workbooks into another sheet

Question

I have 10 excel files in the same folder. I am trying to copy cell A2 of the active worksheet from each of those 10 excel files into a sheet of another excel file - let's call this EX2 file. EX2 has a sheet name Product, I want to have the new 10 values at the end of the column A of this sheet.

Below is my code. I have tried multiple times but it did not work

    Dim Path As String
    Dim Filename As String
    Dim WB As Workbook
    Dim RowCnt As Long
    
    Path = "C:\Users\***\Documents\Folder 10\"
    Filename = Dir(Path & "*.xlsm*")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Do While Filename <> ""
        Set WB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
        For Each ActiveSheet In WB.Sheets
            ActiveSheet.Cells(2, 1).Copy
            RowCnt = ThisWorkbook.Worksheets("Product").Range("A1").End(xlDown).Row + 1
            ThisWorkbook.Worksheets("Product").Range("A" & RowCnt).PasteSpecial xlPasteValues
        Next ActiveSheet
        WB.Close
        Filename = Dir()
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


End Sub

Answer 1

Copy Cell

Option Explicit

Sub copyCell()
    
    Const FolderPath = "C:\Users\***\Documents\Folder 10\"
    
    Dim Filename As String: Filename = Dir(FolderPath & "*.xlsm")
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Product")
    Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, "A").End(xlUp)
    
    Application.ScreenUpdating = False
    Do While Filename <> ""
        Set dCell = dCell.Offset(1)
        With Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True)
            dCell.Value = .ActiveSheet.Range("A2").Value
            .Close False
        End With
        Filename = Dir()
    Loop
    Application.ScreenUpdating = True

End Sub