Below is code that I found on a site by Ron De Bruin. It seems to wor
well for what I am asking it to, but I am curious if there is a way t
speed it up. The folder that it is pulling information from has severa
hundred files and it takes a great deal of time. I'm not sure if perhap
I do not have the right code for this type of process or if there i
anything I can do other than sit and wait for it to update. Or I wa
wondering if there is a way to modify it to only update new files an
paste the information at the next available blank line.... Help i
appreciated. Thanks!

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Cnum As Integer
Dim cell As Range


SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings...."
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.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
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear

rnum = 2

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)

Cnum = 1
For Each cell In mybook.Worksheets(1).Range("D4,I4,C6,D6")
basebook.Worksheets(1).Cells(rnum, Cnum).Value = cell.Value
Cnum = Cnum + 1
Next cell

mybook.Close False
rnum = rnum + 1
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = False
End Su

--
shikamikamoomo
-----------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...fo&userid=2101
View this thread: http://www.excelforum.com/showthread.php?threadid=52574

Hi shikamikamoomoo

I will make a example for you (also for the site)
Tomorrow or Saterday I post back (Busy on this moment)

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


"shikamikamoomoo" <shikamikamoomoo.254sgc_1143131702.7107@excelfor um-nospam.com wrote in message
news:shikamikamoomoo.254sgc_1143131702.7107@excelf orum-nospam.com...

Below is code that I found on a site by Ron De Bruin. It seems to work
well for what I am asking it to, but I am curious if there is a way to
speed it up. The folder that it is pulling information from has several
hundred files and it takes a great deal of time. I'm not sure if perhaps
I do not have the right code for this type of process or if there is
anything I can do other than sit and wait for it to update. Or I was
wondering if there is a way to modify it to only update new files and
paste the information at the next available blank line.... Help is
appreciated. Thanks!

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Cnum As Integer
Dim cell As Range


SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings...."
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.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
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear

rnum = 2

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)

Cnum = 1
For Each cell In mybook.Worksheets(1).Range("D4,I4,C6,D6")
basebook.Worksheets(1).Cells(rnum, Cnum).Value = cell.Value
Cnum = Cnum + 1
Next cell

mybook.Close False
rnum = rnum + 1
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = False
End Sub


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

Thank you so much!!! Greatly appreciated. :)


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

Hi shikamikamoomoo

Here is one to test for you
Will finish it tomorrow and add it to the webpage

Copy the function also in the module

Sub Test_More_Areas()
Dim basebook As Workbook
Dim mybook As Workbook
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Cnum As Integer
Dim cell As Range

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.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 < ""

If IsError(Application.Match(FNames, _
basebook.Worksheets(1).Columns("A"), 0)) Then
rnum = LastRow(basebook.Worksheets(1)) + 1
Set mybook = Workbooks.Open(FNames)

' This will add the workbook name in column A if you want
basebook.Worksheets(1).Cells(rnum, "A").Value = mybook.Name

' Copy the cell values from each cell in one row starting in column B
Cnum = 2
For Each cell In mybook.Worksheets(1).Range("A2,A3,C2,C3,E2,E3")
basebook.Worksheets(1).Cells(rnum, Cnum).Value = cell.Value
Cnum = Cnum + 1
Next cell
mybook.Close False
End If
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

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


"shikamikamoomoo" <shikamikamoomoo.25579p_1143150903.7079@excelfor um-nospam.com wrote in message
news:shikamikamoomoo.25579p_1143150903.7079@excelf orum-nospam.com...

Thank you so much!!! Greatly appreciated. :)


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

hmmm...perhaps I am not copying this into the right location. I copied
the entire code into worksheet 1 and then the Function section into
module 1....is this right? It seems like it does something....but I'm
not sure what. It does not copy anything into the file.


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

Copy both in a normal module(not a sheet module)

Change the path to yours

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


"shikamikamoomoo" <shikamikamoomoo.25763m_1143242701.496@excelforu m-nospam.com wrote in message
news:shikamikamoomoo.25763m_1143242701.496@excelfo rum-nospam.com...

hmmm...perhaps I am not copying this into the right location. I copied
the entire code into worksheet 1 and then the Function section into
module 1....is this right? It seems like it does something....but I'm
not sure what. It does not copy anything into the file.


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

I have update the site
http://www.rondebruin.nl/copy3.htm#new


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


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

I will make a example for you (also for the site)
Tomorrow or Saterday I post back (Busy on this moment)

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


"shikamikamoomoo" <shikamikamoomoo.254sgc_1143131702.7107@excelfor um-nospam.com wrote in message
news:shikamikamoomoo.254sgc_1143131702.7107@excelf orum-nospam.com...

Below is code that I found on a site by Ron De Bruin. It seems to work
well for what I am asking it to, but I am curious if there is a way to
speed it up. The folder that it is pulling information from has several
hundred files and it takes a great deal of time. I'm not sure if perhaps
I do not have the right code for this type of process or if there is
anything I can do other than sit and wait for it to update. Or I was
wondering if there is a way to modify it to only update new files and
paste the information at the next available blank line.... Help is
appreciated. Thanks!

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim rnum As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Cnum As Integer
Dim cell As Range


SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings...."
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.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
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear

rnum = 2

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)

Cnum = 1
For Each cell In mybook.Worksheets(1).Range("D4,I4,C6,D6")
basebook.Worksheets(1).Cells(rnum, Cnum).Value = cell.Value
Cnum = Cnum + 1
Next cell

mybook.Close False
rnum = rnum + 1
FNames = Dir()
Loop

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = False
End Sub


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

I'm not sure what I am doing wrong, but I cannot get this to copy
anything over. I've tried copying the entire code including the
Function into Module 1. But when I run it nothing happens. Do I need
this code plus the original? I changed the path to the right location
and I do not get any errors.


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

Send me your test file with the code private and I will see where you went wrong

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


"shikamikamoomoo" <shikamikamoomoo.259maq_1143357023.483@excelforu m-nospam.com wrote in message
news:shikamikamoomoo.259maq_1143357023.483@excelfo rum-nospam.com...

I'm not sure what I am doing wrong, but I cannot get this to copy
anything over. I've tried copying the entire code including the
Function into Module 1. But when I run it nothing happens. Do I need
this code plus the original? I changed the path to the right location
and I do not get any errors.


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746

Sent a copy of the file....thanks for your help :)


--
shikamikamoomoo
------------------------------------------------------------------------
shikamikamoomoo's Profile: http://www.excelforum.com/member.php...o&userid=21018
View this thread: http://www.excelforum.com/showthread...hreadid=525746