Norman,
Yes that works GREAT.
Thanks very much.
Dave
Norman Jones Wrote:
Hi Dave,

As a minor addendum, should you wish to hide the deletion of histori
data
from the user, move the line ( and comment):

'Initially, delete old data!!
ThisWorkbook.Sheets(1).Range("List").ClearContents

down two lines, so that it follows the instruction:

Application.ScreenUpdating = False

---
Regards,
Norman



"Piranha" wrot
in
message ...

Norman Jones Wrote:
Hi Dave,
See the following comprehensive post from Dave Peterson:
http://tinyurl.com/b6oyc
---
Regards,
Norman

"Piranha"
wrote
in
messag
...

Norman,
Whats the url where you can do this?
DaveNorman Jones Wrote:
Hi Dave,
Reading plain text NG posts, I (and most contributors to the NG
am
unable
to see your 'red' data.

Regards,
Norman

"Piranha"
wrote
in
messag
..
[/url]
--
Piranha


------------------------------------------------------------------------
Piranha's Profile:
http://www.excelforum.com/member.php...o&userid=20435
View this thread:
http://www.excelforum.com/showthread...hreadid=467024
Hi Norman,
Thanks for the link, very interesting.

For anyone interested in this thread. Norman has furnished me wit
the
following code,
which solves all my problems. It works flawlessly.
Thank you very very much Norman.

Code:
--------------------
'===================
Sub CopyPasteStoreData()
Dim rngFileNames As Range
Dim rCell As Range
Dim WB As Workbook
Dim filelistSH As Worksheet
Dim copySH As Worksheet
Dim destSH As Worksheet
Dim RngCopy As Range
Dim RngDest As Range
Dim LastRow As Long
Dim iCtr As Long
ActiveSheet.Unprotect password:="xxx"
'Initially, delete old data!!
ThisWorkbook.Sheets(1).Range("List").ClearContents
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With ThisWorkbook
Set filelistSH = .Sheets("Sheet2")
Set destSH = .Sheets("sheet1")
End With
With filelistSH
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Set rngFileNames = .Range("B1").Resize(LastRow)
End With
For Each rCell In rngFileNames.Cells
If Not IsEmpty(rCell) Then
'Open file listed in B1.
On Error Resume Next 'In case file not found!
Set WB = Nothing
Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & rCell.Value)
On Error GoTo 0
If Not WB Is Nothing Then
Set copySH = WB.Sheets(1)
Set RngCopy = copySH.Cells(Rows.Count, "C").End(xlUp).EntireRow
Set RngDest = destSH.Range("A6").Offset(iCtr)
RngCopy.Copy Destination:=RngDest
'Close file copied from.
WB.Close savechanges:=False
iCtr = iCtr + 2
End If
End If
Next rCell
destSH.Range("F1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveSheet.Protect , password:="xxx"
End Sub
'<<=====================
--------------------


--
Piranha

------------------------------------------------------------------------
Piranha's Profile:
http://www.excelforum.com/member.php...o&userid=20435
View this thread
http://www.excelforum.com/showthread...hreadid=467024


--
Piranh
-----------------------------------------------------------------------
Piranha's Profile: http://www.excelforum.com/member.php...o&userid=20435
View this thread: http://www.excelforum.com/showthread...hreadid=467024