#1
|
|||
|
|||
linking in excel
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 :-) |
#2
|
|||
|
|||
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. |
#3
|
|||
|
|||
Umm
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"
|
#4
|
|||
|
|||
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...
|
#5
|
|||
|
|||
incoming
Well im sending those fils well i must say o owe you a big time thank you in advance
|
#6
|
|||
|
|||
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.
Code:
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 |
#7
|
|||
|
|||
Hey than you a lot
|
#8
|
|||
|
|||
You're wellcome
|
#9
|
|||
|
|||
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) 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 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 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 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
linking to excel from word | jillapass | Word VBA | 5 | 06-08-2012 01:28 AM |
linking word from Excel | Lorna B | Word | 1 | 03-22-2012 03:36 PM |
Excel to powerpoint linking | mugezhn | Excel | 0 | 07-08-2010 02:56 AM |
Linking Excel to Word | engineer_in_training | Word | 0 | 01-06-2010 01:30 PM |
Linking from Excel to Word | streng | Word | 4 | 10-28-2008 08:23 AM |