importing data from an array of workbooks

mjo0815

New Member
Joined
Apr 14, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
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
VBA 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
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,123
Messages
5,852,291
Members
431,494
Latest member
ilike1664

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top