importing data from an array of workbooks

[mjo0815]

windows (x64)Excel VersionOffice 365

Hi,

I am new here and I hoppe you guys apologize that I am not a native speaker.
I have tried different solutions for my challenge and honestly I always failed.
Unfortunately I am not a VBA expert, I was programming last time 25 years ago.

Source files:
- different xls* files, inn different folders
- they are containing in different sheets ("main" and "plan") cell values (single cells, no ranges)
- some of them I want to import into a ****pit file

destination file:
- "****pit", so far one sheet "GF"
- it should become a table, with a header in line 1
- per line I need to import the values of the source files in to (B2,3,4,5,6...)
- in one cell (A2,3,4...) I copied the full path of the source file for this line (c:\user\.....\example.xlsm)*
* a workaround, because I failed to create a parser in subfolders

I want the macro:
- to open the workbooks specified in column A
- copy the date from different cells in different sheet into the current line
- not changing the source files (in my tries I frequently corrupted the source)

so far:
- I made the array working and the loop ready (thanks to some codes I have found)
- It seems , all the workbooks are opening/closing one by one, the target cells are getting activated, but no content is pasted (my clipboard is empty)
- sometimes sources are corrupted, when I turn ReadOnly in open into True, I am getting prompted for each file to select a filename to be saved (I don't want to change the sources)

What went wrong?

I would be very happy to get some support here!

Best
Martin


Code

Sub Update()
    Dim lr As Long
    Dim i As Integer
    Dim WBSsource As Workbook
    Dim FileNames As Variant
    Dim msg As String


    With ThisWorkbook.Sheets("GF")
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        FileNames = .Range("A2:A" & lr).Value
    End With
    For i = LBound(FileNames, 1) To UBound(FileNames, 1)
        On Error Resume Next
        If FileNames(i, 1) Like "*.xls*" Then
            Set WBSsource = Workbooks.Open(FileNames(i, 1), _
                                           ReadOnly:=False, _
                                           Password:="")
            If Err = 0 Then
                With WBSsource
                  
                  
                  Workbooks.Open ThisWorkbook.Worksheets("GF").Range("A" & i)
                    
                  WBSource.Sheets(main).Range(B4).Copy
                  Workbooks("****pit.xlsm").Worksheets("GF").Range("B" & i + 1).PasteSpecial Paste:=xlPasteValues
                    
                  
                
                  Workbooks(FileNames(i, 1)).Close SaveChanges:=False
                                    
                    
                    
                    
                    .Close True
                End With
            Else
                msg = msg & FileNames(i, 1) & Chr(10)
                On Error GoTo 0
            End If
        End If
        Set WBSsource = Nothing
    Next i
    If Len(msg) > 0 Then
        MsgBox "The Following Files Could Not Be Opened" & _
               Chr(10) & msg, 48, "Error"
    End If
End Sub