K
Kris
I found this awesome macro on Ron de Bruin's site
(http://www.rondebruin.nl) that has let me copy a range from a closed
workbook on a shared drive. However when I encouter blank cells they
show us as 0 which throws off my other macros. No matter what I do to
change the function it still shows up with 0's.
Here is the code.
Sub GetRange(FilePath As String, FileName As String, SheetName As
String, _
SourceRange As String, DestRange As Range)
Dim Start
'Go to the destination range
Application.Goto DestRange
'Resize the DestRange to the same size as the SourceRange
Set DestRange = DestRange.Resize(Range(SourceRange).Rows.Count, _
Range(SourceRange).Columns.Count)
'Add formula links to the closed file
With DestRange
.FormulaArray = "='" & FilePath & "/[" & FileName & "]" &
SheetName _
& "'!" & SourceRange
'Wait
Start = Timer
Do While Timer < Start + 2
DoEvents
Loop
'Make values from the formulas
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
True, Transpose:=False
.Cells(1).Select
Application.CutCopyMode = False
End With
End Sub
Sub File_In_Network_Folder()
Application.ScreenUpdating = False
On Error Resume Next
'Call the macro GetRange
GetRange "\\dfw2nap01\global\SPECIAL\Bess", "abetest1.xls",
"Solution Direct Tracking", "A:AA", _
Sheets("Solution Direct Tracking").Range("A1")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
(http://www.rondebruin.nl) that has let me copy a range from a closed
workbook on a shared drive. However when I encouter blank cells they
show us as 0 which throws off my other macros. No matter what I do to
change the function it still shows up with 0's.
Here is the code.
Sub GetRange(FilePath As String, FileName As String, SheetName As
String, _
SourceRange As String, DestRange As Range)
Dim Start
'Go to the destination range
Application.Goto DestRange
'Resize the DestRange to the same size as the SourceRange
Set DestRange = DestRange.Resize(Range(SourceRange).Rows.Count, _
Range(SourceRange).Columns.Count)
'Add formula links to the closed file
With DestRange
.FormulaArray = "='" & FilePath & "/[" & FileName & "]" &
SheetName _
& "'!" & SourceRange
'Wait
Start = Timer
Do While Timer < Start + 2
DoEvents
Loop
'Make values from the formulas
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
True, Transpose:=False
.Cells(1).Select
Application.CutCopyMode = False
End With
End Sub
Sub File_In_Network_Folder()
Application.ScreenUpdating = False
On Error Resume Next
'Call the macro GetRange
GetRange "\\dfw2nap01\global\SPECIAL\Bess", "abetest1.xls",
"Solution Direct Tracking", "A:AA", _
Sheets("Solution Direct Tracking").Range("A1")
On Error GoTo 0
Application.ScreenUpdating = True
End Sub