View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Alvin Hansen[_2_] Alvin Hansen[_2_] is offline
external usenet poster
 
Posts: 209
Default For the hard one -- myabe Tom??

Hi
I use this code :
Sub Copyrange1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "h:\city breaks\priser\usa\"
ChDrive MyPath
ChDir MyPath
FNames = Dir("fil.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames)

Set sourceRange = basebook.Worksheets("fil").Range("a1:c5")
Set destrange = mybook.Worksheets(1).Range("a1")
sourceRange.copy destrange
' Instead of this lines you can use the code below to copy only the
values

' Set sourceRange = basebook.Worksheets(1).Range("a1:c5")
' Set destrange = mybook.Worksheets(1).Range("a1:c5")
' destrange.Value = sourceRange.Value

mybook.Close True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Its working aalright until i set this in to a sheet
Private Sub Worksheet_Calculate()
Dim oPic As Picture
Me.Pictures.Visible = False
With Range("a53")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
End Sub

if i use thisthen i get an error on mybook.Close True
and the file stand open.

Hope some can help the code is not in the same sheet as Copyrange ref. to

Regards alvin