Macro to copy from workbooks listed as http links

[Guest]

Hi,

Is it possible to have a macro for this:

1. Master workbook contains a sheet listing a set of sub-workbooks as http
links
2. Open linked sub-workbooks (either all at once or individually)
3. Copy defined range of cells from defined sheet name in opened
sub-workbook to the master workbook (data only, not formatting). (Range and
sheet name is same for all sub-workbooks). Do this for all the linked
workbooks without overwriting any of the previous copied cells.
4. Close sub-workbook(s)

Alternatively, can this be done with the workbooks all stored as files ina
named network directory?

Thanks,

Nick


that will open all workbooks listed on a sheet as http links, copy a
defined set of cell data from one of the sheets into the master workbook, and
then close the workbook.

 

[Ardus Petus]

I presume what you call subworkbooks are worksheets

Regards,

 

[Guest]

What I mean is that I have several excel files (sub-workbooks) with different
file names saved on a network drive. It is the cell data contained in one
sheet of each of these files that I need to import to a master file.

 

[Guest]

assume they are all stored in a single folder and you want to process all
files in that folder. the master workbook is not in that folder. Master
workbook contains the code and data is copied to the first sheet in the tab
order, starting in the next available cell in column A. Data to be copied
from each workbook is in the first sheet in the tab order in cells A1:F20

Sub GetData()
Dim sPath as String, sName as String
Dim rng as Range, bk as Workbook
sPath = "C:\Myfolder\"
sname = dir(sPath & "*.xls")
do while sName <> ""
set rng = thisworkbook.worksheets(1).Cells(rows.count,1).End(xlup)(2)
set bk = workbooks.Open(sPath & sname)
bk.worksheets(1).Range("A1:F20").copy rng
bk.close Savechanges:=False
sName = dir()
Loop
End Sub


Adjust to suit your actual situation.

 

[Guest]

Thanks Tom. So I can amend it for my particular needs, can you please tell
me what the different parts of this line do?

Set rng = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp)(2)

I presume I can change the first (1) to ("Sheet Name") to go to the sheet I
want, but what do the next 2 expressions do exactly? I want them to go to
the next empty cell in column A after cell A14 for the pasting action. Not
familiar with the End(xlUp)(2) expression at all.

Thanks in advance,

Nick

 

[Tom Ogilvy]

That line fines the next empty cell in coulmn A.

in a new worksheet, go to A14 and enter the number 10. Now hit the end key,
then the down arrow. That takes you to the bottom of the sheet. This is
where that line of code start. Now hit End and then the up arrow. You
should now be back at A14. That is what the End(xlup) does.
Cells(rows.count,1) specifies to start in A65536. the (2) on the end
means go to the next cell down. So it would put you on A15 (or rather give
you a reference to A15).

Yes, you can replace the 1 with the sheet name.

to start in A14

Sub GetData()
Dim sPath as String, sName as String
Dim rng as Range, bk as Workbook
Dim vA as Variant

vA = "Sheet1"

sPath = "C:\Myfolder\"
sname = dir(sPath & "*.xls")
do while sName <> ""
if isempty(thisworkbook.worksheets(vA).Range("A14")) then
set rng = Thisworkbook.Worksheets(vA).Range("A14")
else
set rng = thisworkbook.worksheets(vA) _
.Cells(rows.count,1).End(xlup)(2)
End if
set bk = workbooks.Open(sPath & sname)
bk.worksheets(1).Range("A1:F20").copy rng
bk.close Savechanges:=False
sName = dir()
Loop
End Sub

 

[Guest]

Works a treat. Thanks very much.

That line fines the next empty cell in coulmn A.

in a new worksheet, go to A14 and enter the number 10. Now hit the end key,
then the down arrow. That takes you to the bottom of the sheet. This is
where that line of code start. Now hit End and then the up arrow. You
should now be back at A14. That is what the End(xlup) does.
Cells(rows.count,1) specifies to start in A65536. the (2) on the end
means go to the next cell down. So it would put you on A15 (or rather give
you a reference to A15).

Yes, you can replace the 1 with the sheet name.

to start in A14

Sub GetData()
Dim sPath as String, sName as String
Dim rng as Range, bk as Workbook
Dim vA as Variant

vA = "Sheet1"

sPath = "C:\Myfolder\"
sname = dir(sPath & "*.xls")
do while sName <> ""
if isempty(thisworkbook.worksheets(vA).Range("A14")) then
set rng = Thisworkbook.Worksheets(vA).Range("A14")
else
set rng = thisworkbook.worksheets(vA) _
.Cells(rows.count,1).End(xlup)(2)
End if
set bk = workbooks.Open(sPath & sname)
bk.worksheets(1).Range("A1:F20").copy rng
bk.close Savechanges:=False
sName = dir()
Loop
End Sub

 

[Guest]

Tom,

This is working great, but I have one more refinement that I could do with
some help on. When the macro copies the information to the master workbook,
how do I modify this line:

bk.worksheets(1).Range("A1:F20").copy rng

so that it only copies the values and not the formulas too?

I also get the 'update/don't update' links and 'continue' dialogue screens
come up as it cycles through. Is there any way to automatically select both
"update" and "continue".

Thanks very much,

Nick

 

[Tom Ogilvy]

Sub GetData()
Dim sPath as String, sName as String
Dim rng as Range, bk as Workbook
Dim vA as Variant

vA = "Sheet1"

sPath = "C:\Myfolder\"
sname = dir(sPath & "*.xls")
do while sName <> ""
if isempty(thisworkbook.worksheets(vA).Range("A14")) then
set rng = Thisworkbook.Worksheets(vA).Range("A14")
else
set rng = thisworkbook.worksheets(vA) _
.Cells(rows.count,1).End(xlup)(2)
End if
set bk = workbooks.Open(FileName:=sPath & sname, UpdateLinks:=0)
bk.worksheets(1).Range("A1:F20").copy
rng.PasteSpecial xlValues
bk.close Savechanges:=False
sName = dir()
Loop
End Sub


I assumed you didn't want to update links. If you want to update links here
is the argument list to updatelinks

0 - Doesn't update any references
1 - Updates external references but not remote references
2 - Updates remote references but not external references
3 - Updates both remote and external references