VBA to get a range or worksheet from a closed workbook

D

dovrox

eg - workbook on a server holds data - it has a tab called "Costing" an
the file is closed.
What VBA will allow me to import the whole tab or a range from that ta
into my current workbook
 
J

jeff

Hi,

BrianB posted this a while back - take a look
and see what of this code you can use.

jeff
================================================

Here is some code that you will need to copy/paste to a
code module and
adapt. You may get away with just changing the *Sub
Transfer_Data ()*
to transfer cell values instead of using copy/paste. eg.
ToSheet. Range("A1").Value = Fromsheet.Range("A1").Value

'==============================================
'- Generic code for transferring data from
'- one or more workbooks in a folder to a master sheet
'-
'- workbooks must be the only ones in the folder
'- run this code from the master book
'-
'----------------------------------------------
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'----------------
Sub NEW_MASTER()
'----------------
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
Set ToSheet = ActiveWorkbook.Worksheets(1)
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(Cells(2, 1), Cells(ToRow,
NumColumns)).ClearContents
End If
ToRow = 2
'- main loop
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data
End If
FromBook = Dir
Wend
'-- close
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'-------------------------------------------------

Sub Transfer_data()
Workbooks.Open FileName:=FromBook
For Each FromSheet In Workbooks(FromBook).Worksheets
LastRow = FromSheet.Range("A65536").End(xlUp).Row
'- copy paste
FromSheet.Range(Cells(2, 1), Cells(LastRow,
NumColumns)).Copy
_
Destination:=ToSheet.Range("A" & ToRow)
'- set next ToRow
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
Next
Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ======================================
 
Top