linking in excel

[OssOss]

Hya for all i have a bit fifficult question thus its possible to create a dinamically changing link in excel i mean i have a buch of excel files and i need to extract exact data from them to an another excel file and im too lazy to create a separate long command lines for all of them i wanna to make an one command line and dinamically replace the file name in that command which ones are indicated in the adjacent columm in the output sheet.


all files are named lkie this :1.slxs, 2.xlsx.... up to thousands...

i thinking about a solutions something like this:
='C:\Users\Oss\Downloads\[(number of the file).xlsx]Sheet1'!$A$1

is there possible to do a stuff like that?

who solve it for me i owe him a beer :-)

[Catalin.B]

Your problem is very similar to this one: https://www.msofficeforums.com/excel...ta-source.html
The code can be changed to take the data from all excel files in a folder...
But , obviously or not, this is not the only way.

[OssOss]

Well its loooks like i kinda still a bit of lost how to get it done :-((shame on me) fo example i wanted to use a wariable from cell C1 as a "filename"

[Catalin.B]

Upload a file with a list of source files names, and specify the range of cells you need from these files, i will give you a sample code...

[OssOss]

Well im sending those fils well i must say o owe you a big time thank you in advance

[Catalin.B]

This is the code you will find in the file attached. Just press the start button , in the browse window that comes up, navigate to the folder that contains your source files and double click any file from that folder; the code opens every file from that folder and copies cells A58 to column D.

Option Explicit
Sub ChangeLinks()
Application.ScreenUpdating = False
Dim NewLnk As String
 
NewLnk = Application.GetOpenFilename("Excel files,*.xl*", _
                           1, "Choose any file in the source folder", , False)
                           
       If TypeName(NewLnk) = "Boolean" Then Exit Sub
       
    Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

Dim Fisier, FolderSursa As String, LastRow As Long
LastRow = ThisWorkbook.Sheets("1000000").Range("D" & Rows.Count).End(xlUp).Row
  FolderSursa = oFSO.GetFile(NewLnk).ParentFolder
         For Each Fisier In oFSO.GetFolder(FolderSursa).Files
            Workbooks.Open (Fisier)
            ActiveSheet.Cells(58, "A").Copy
            ThisWorkbook.Activate
            ThisWorkbook.Sheets("1000000").Cells(LastRow + 1, "D").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Workbooks(Fisier.Name).Close savechanges:=False
            LastRow = LastRow + 1
         Next
         
 
End Sub

[OssOss]

Hey than you a lot

[Catalin.B]

You're wellcome

[Catalin.B]

Well, i took the time to make another solution to your problem, with another approach, which is much faster than the previous , because it extracts the data from the target files without opening and closing those files. This version uses the list of workbooks in column A and a defined name with an Excel 4 macro formula (GET.CELL) to extract the file name from the existing link. Of course, this can be done completely in the code.
You might need to manually change the link from cell B3 to a real file in your computer, the code will not run with a broken link (actual link is to a file in my computer)

Option Explicit
Sub ChangeLinks()
Application.ScreenUpdating = False
Dim OldLnk, NewLnk, Target, i As String, j As Integer
 
NewLnk = Application.GetOpenFilename("Excel files,*.xl*", _
                           1, "Choose any file in the source folder", , False)
                           
       If TypeName(NewLnk) = "Boolean" Then Exit Sub
       
    Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

Dim Fisier, FolderSursa As String, LastRow As Long
LastRow = ThisWorkbook.Sheets("1000000").Range("D" & Rows.Count).End(xlUp).Row
  FolderSursa = oFSO.GetFile(NewLnk).ParentFolder
        For j = 3 To Sheets("1000000").Range("A" & Rows.Count).End(xlUp).Row
                 For Each Fisier In oFSO.GetFolder(FolderSursa).Files
                      Target = Sheets("1000000").Cells(j, "A")
                          If InStr(1, Fisier.Name, Target, vbTextCompare) > 0 Then
                              i = Fisier.Name
                              OldLnk = Sheets("1000000").Cells(3, "C").Text
                              ActiveWorkbook.ChangeLink Name:=OldLnk, _
                              NewName:=i, Type:=xlExcelLinks
                              Sheets("1000000").Cells(3, "B").Copy
                              Sheets("1000000").Cells(LastRow + 1, "D").Select
                              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
                              LastRow = LastRow + 1
                           End If
                 Next
         Next j
 Application.CutCopyMode = False
End Sub

If you do not want to use a defined name to extract tha path to source file, and you want the code to do all the work, you have to use this code:

Option Explicit
Sub ChangeLinks()
Application.ScreenUpdating = False
Dim OldLnk, NewLnk, Target, i As String, j As Integer
 
NewLnk = Application.GetOpenFilename("Excel files,*.xl*", _
                           1, "Choose any file in the source folder", , False)
                           
       If TypeName(NewLnk) = "Boolean" Then Exit Sub
       
    Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

Dim Fisier, FolderSursa As String, LastRow As Long
With ThisWorkbook.Sheets("1000000")
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
  FolderSursa = oFSO.GetFile(NewLnk).ParentFolder
        For j = 3 To .Range("A" & Rows.Count).End(xlUp).Row
                 For Each Fisier In oFSO.GetFolder(FolderSursa).Files
                      Target = .Cells(j, "A")
                          If InStr(1, Fisier.Name, Target, vbTextCompare) > 0 Then
                              i = Fisier.Name
                              
                            With Application ' extracting path with VB from existing link in cell B3 (without using defined name in worksheet)
                               OldLnk = .Substitute(.Cells(3, "B").Formula, "=", "")
                               OldLnk = Left(OldLnk, .Find("]", OldLnk) - 1)
                               OldLnk = .Substitute(OldLnk, "[", "")
                            End With
                              
                              
                              ActiveWorkbook.ChangeLink Name:=OldLnk, _
                              NewName:=i, Type:=xlExcelLinks
                              .Cells(3, "B").Copy
                              .Cells(LastRow + 1, "D").Select
                              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                              :=False, Transpose:=False
                              LastRow = LastRow + 1
                           End If
                 Next
         Next j
 Application.CutCopyMode = False
 End With
End Sub