Getting 438 error Object doesn't support this

Question

I have folder with workbooks which I'm trying to merge into one workbook and while it's looping through workbooks I gather some information from Sheets to "Main" sheet. Each Sheet except "Main" contains this kind of tables: https://imgur.com/2kvZjNX . I need to text join all values ( written as Text in the image) in the columns Root_cause and Solutions and put them in appropriate column in the Main sheet and it needs to look like this: https://imgur.com/rWJaC4W Because there are cases like this: https://imgur.com/m0MQnXJ where Root_cause column can contain merged cells I came up with the solution:

1. Let's take i from 1 to 100 ( because root_cause/solutions table doesnt get that big from sheet to sheet)

2. Look for sign "№", once found - exit from loop

3. Create empty variables s (for text joining Root_cause values and putting it in column "D" in the "Main" sheet) and s1 (for text joining Solution values for column "E" in the "Main" sheet) 4.) Since there are cases when there are merged cells (and I assume VBA treats rest cells as empty when looping) for Root_cause column I put condition that unless values in both columns are empty - continue storing values I get 438 error Object doesn't support this property or method on this line: https://imgur.com/DIaWwCz Maybe my approach is conceptually wrong, I dont know ...

Here's my code:

Sub Merge()
    Path = "C:\Users\mdoskarin001\Desktop\SVOD2\"
    Filename = Dir(Path & "*xlsx")
    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
        sDate = Workbooks(Filename).Sheets(1).Cells(7, 3).Value
        sTitle = Workbooks(Filename).Sheets(1).Cells(2, 3).Value

        For Each Workbook In Workbooks
            If Workbook.Name <> ThisWorkbook.Name Then
                Workbook.Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
                ThisWorkbook.Sheets("Main").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Filename
                ThisWorkbook.Sheets("Main").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = sTitle
                ThisWorkbook.Sheets("Main").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = sDate
                For i = 1 To 100
                    If Workbooks(Filename).Sheets(1).Cells(i, 1).Value = "№" Then
                        Exit For
                    End If
                Next i
                i = i + 1
                s = ""
                s1 = ""
                j = i
                Do
                    If Workbooks(Filename).Sheets(1).Cells(j, 2).Value <> "" Then
                        s = s + Workbooks(Filename).Sheets(1).Cells(j, 2).Value + vbCrLf
                    End If
                Loop While Workbooks(Filename).Cells(j, 2).Value <> "" Or Workbooks(Filename).Cells(j, 3).Value <> ""

                For j = 1 To 100

                    s = s + Workbooks(Filename).Sheets(1).Cells(j, 2).Value + vbCrLf
                    s1 = s1 + Workbooks(Filename).Sheets(1).Cells(j, 3).Value + vbCrLf
                Next j

                ThisWorkbook.Sheets("Main").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = s
                ThisWorkbook.Sheets("Main").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = s1
            End If
        Next

        Set Workbook = Nothing
        Workbooks(Filename).Close savechanges:=False
        Filename = Dir()
    Loop         
End Sub

Answer 1

As Question is not clear it assumtion is based only on the data shown in the image. Also assumed that only 1st sheet of each file is to be merged

may try by modifying code to your requirement

Sub Merge()
Dim Path As String, FileName As String, Wb As Workbook, Wm As Worksheet, Wt As Worksheet
Dim C As Range, MrgRw As Long, Sdate, STitle, SRoot, RwOff As Long, Txt As String
Dim lastRow As Long
Path = "C:\Users\user\Documents\Protocol\"
FileName = Dir(Path & "*xlsx")
Set Wm = ThisWorkbook.Sheets("Main")
lastRow = Wm.Range("A" & Rows.Count).End(xlUp).Row

    Do While FileName <> ""
    If FileName <> ThisWorkbook.Name Then
    Set Wb = Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
    Wb.Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
    Wb.Close False
    Set Wt = ThisWorkbook.Sheets(2)
    Sdate = Wt.Cells(7, 3).Value
    STitle = Wt.Cells(2, 3).Value

    Set C = Wt.Range("A1:A100").Find(ChrW(&H2116), LookIn:=xlValues) '
    If Not C Is Nothing Then
    RwOff = 1
      Do While C.Offset(RwOff, 1).Value <> ""
      SRoot = C.Offset(RwOff, 1).Value
      lastRow = lastRow + 1
      MrgRw = C.Offset(RwOff, 1).MergeArea.Rows.Count
      Txt = ""
        For i = 0 To MrgRw - 1
        Txt = Txt & (i + 1) & "." & C.Offset(RwOff + i, 2).Value & vbCrLf
        Next
      Txt = IIf(Len(Txt) > 0, Left(Txt, Len(Txt) - 1), Txt)
      Wm.Range("A" & lastRow).Value = FileName
      Wm.Range("B" & lastRow).Value = STitle
      Wm.Range("C" & lastRow).Value = Sdate
      Wm.Range("D" & lastRow).Value = SRoot
      Wm.Range("E" & lastRow).Value = Txt
      RwOff = RwOff + MrgRw
      Loop
    End If

    FileName = Dir()
    End If
    Loop
End Sub