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 (yes, there had been already bulky PC on the market ).
- 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 cockpit file
- "cockpit", 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 sourcefile 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)
- 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!
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("cockpit.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