G
Guest
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
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