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

For the hard one -- myabe Tom??
 

Hi alvin

Disable the events

See the info on top of my page
http://www.rondebruin.nl/copy4.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl



"Alvin Hansen" wrote in message ...
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

For the hard one -- myabe Tom??
 

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
Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

is what I believe Ron is suggesting and it sounds good to me.

--
Regards,
Tom Ogilvy


"Ron de Bruin" wrote in message
...
Hi alvin

Disable the events

See the info on top of my page
http://www.rondebruin.nl/copy4.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl



"Alvin Hansen" wrote in message
...
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

For the hard one -- myabe Tom??
 

well then this doen't work
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
When i try to update the sheet nothing happens it dosn't change the picture
MAybe i shall give up on this?

regards alvin


"Tom Ogilvy" skrev:

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
Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

is what I believe Ron is suggesting and it sounds good to me.

--
Regards,
Tom Ogilvy


"Ron de Bruin" wrote in message
...
Hi alvin

Disable the events

See the info on top of my page
http://www.rondebruin.nl/copy4.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl



"Alvin Hansen" wrote in message
...
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

For the hard one -- myabe Tom??
 

Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True

Turned the events off, turned them back on. If it worked before, it should
work now. (Unless you had an error in mybook.close True and it never
reached the line to turne them back on - in that case, run this code:)

Sub AllowEvents()
Application.EnableEvents = True
End Sub

--
Regards,
Tom Ogilvy


"Alvin Hansen" wrote in message
...
well then this doen't work
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
When i try to update the sheet nothing happens it dosn't change the
picture
MAybe i shall give up on this?

regards alvin


"Tom Ogilvy" skrev:

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
Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

is what I believe Ron is suggesting and it sounds good to me.

--
Regards,
Tom Ogilvy


"Ron de Bruin" wrote in message
...
Hi alvin

Disable the events

See the info on top of my page
http://www.rondebruin.nl/copy4.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl



"Alvin Hansen" wrote in
message
...
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

For the hard one -- myabe Tom??
 

Thanks its working with
Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True

regards alvin


"Tom Ogilvy" skrev:

Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True

Turned the events off, turned them back on. If it worked before, it should
work now. (Unless you had an error in mybook.close True and it never
reached the line to turne them back on - in that case, run this code:)

Sub AllowEvents()
Application.EnableEvents = True
End Sub

--
Regards,
Tom Ogilvy


"Alvin Hansen" wrote in message
...
well then this doen't work
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
When i try to update the sheet nothing happens it dosn't change the
picture
MAybe i shall give up on this?

regards alvin


"Tom Ogilvy" skrev:

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
Application.EnableEvents = False
mybook.Close True
Application.EnableEvents = True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

is what I believe Ron is suggesting and it sounds good to me.

--
Regards,
Tom Ogilvy


"Ron de Bruin" wrote in message
...
Hi alvin

Disable the events

See the info on top of my page
http://www.rondebruin.nl/copy4.htm



--
Regards Ron de Bruin
http://www.rondebruin.nl



"Alvin Hansen" wrote in
message
...
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