PDA

View Full Version : Button to import cells from another spreadsheet



Hankins
07-19-2009, 06:33 AM
I'd like a button to import cells from another spreadsheet. Ideally, I'd like to click the button and get prompted to pick the file to import from.

The import file will import the same cells into the open spreadsheet each time.

For example:

Import.xls will send data from A1, A2, A3 & A4 to C1, C2,C54 & C86 in openspdsht.xls

Thanks for the help!!

mdmackillop
07-19-2009, 08:02 AM
Will both books be open when you run the macro? What are the relative sheet names?

MaximS
07-19-2009, 08:18 AM
hi Hankins,
you can try attach below to your button:


Sub Import()
Dim Filename As String
Dim Wb As Workbook
Filename = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
Set Wb = Workbooks.Open(Filename)
Wb.Sheets("Sheet1").Range("C1:C2").Value = _
ThisWorkbook.Worksheets("Sheet1").Range("A1:A2").Value
Wb.Worksheets("Sheet1").Range("C54").Value = _
ThisWorkbook.Worksheets("Sheet1").Range("A3").Value
Wb.Worksheets("Sheet1").Range("C86").Value = _
ThisWorkbook.Worksheets("Sheet1").Range("A4").Value
End Sub

Hankins
07-19-2009, 09:27 AM
Both sheets will not be open. Only the sheet that I'm importing to.

The sheet that I'm importing from will be "data"
The sheet that I'm importing to will be "estimate"

Hankins
07-19-2009, 04:50 PM
Both sheets will not be open. Only the sheet that I'm importing to.

The sheet that I'm importing from will be "data"
The sheet that I'm importing to will be "estimate"

GTO
07-19-2009, 08:46 PM
...Ideally, I'd like to click the button and get prompted to pick the file to import from...

...Import.xls will send data from A1, A2, A3 & A4 to C1, C2,C54 & C86 in openspdsht.xls...


Greetings,

I did not include a button, but see if this helps. As it appears that we are not grabbing skads of data from the closed wb, I thought GetData from johnske's article at: http://www.vbaexpress.com/kb/getarticle.php?kb_id=454

....would be a handy way.

In a Standard Module:

Option Explicit

Sub ImportSmallBitsOfData()
Dim _
lMarker As Long, _
strPath As String, _
strFilePicked As String, _
strFileName As String

'// Change names of Destination and Source sheets to match what you have. //
Const SOURCE_SHEET_NAME As String = "data"
Const DEST_SHEET_NAME As String = "estimate"

'// Change strPath to where you want GetOpenFilename to initially open to. //
strPath = ThisWorkbook.Path & Application.PathSeparator
ChDir strPath
'// Return the fullname of the wb picked, else return "False" which will then //
'// cause an exit. //
strFilePicked = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls),*.xls", _
Title:="Pick File to Import From", _
MultiSelect:=False)
If strFilePicked = "False" Then Exit Sub

'// Figure out where the last reverse solidus is, so we can return the Path and //
'// filename picked. //
lMarker = InStrRev(strFilePicked, Application.PathSeparator, -1, vbTextCompare)
strPath = Left(strFilePicked, lMarker)
strFileName = Right(strFilePicked, Len(strFilePicked) - lMarker)

With ThisWorkbook.Worksheets(DEST_SHEET_NAME)
.Range("C1").Value = GetData(strPath, strFileName, SOURCE_SHEET_NAME, "$A$1")
.Range("C2").Value = GetData(strPath, strFileName, SOURCE_SHEET_NAME, "$A$2")
.Range("C54").Value = GetData(strPath, strFileName, SOURCE_SHEET_NAME, "$A$3")
.Range("C86").Value = GetData(strPath, strFileName, SOURCE_SHEET_NAME, "$A$4")
End With
End Sub

'// See johnske's KB entry at: http://www.vbaexpress.com/kb/getarticle.php?kb_id=454 //
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function


Hope that helps,

Mark