--
uberblah
------------------------------------------------------------------------
uberblah's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=28050
View this thread: http://www.excelforum.com/showthread.php?threadid=475597
Example, looking for the values in range A3:L3 on sheet 1 in every workbook
to be listed in order underneath each other on a single consolidation
worksheet:-
Ron De Bruin has lots of examples for this kind of thing on his website
http://www.rondebruin.nl/tips.htm
but if you give us some more detail then maybe we can give you more tailored
advice
--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03
------------------------------Â------------------------------Â----------------
It's easier to beg forgiveness than ask permission :-)
------------------------------Â------------------------------Â----------------
"uberblah" <uberblah.1wt4yb...@excelforum-nospam.com> wrote in
message news:uberblah.1wt4yb...@excelforum-nospam.com...
I need values in range A4:AK4 in every workbook to be listed in order
underneath each other on a single consolidation worksheet. There are
no sheet1/2/3 in these files, so they be be considered forms?
Ken Wright Wrote:
> Give us details of what data is in there (ie ranges) and how you want
> it
> consolidated, where do you want the data to go.
>
> Example, looking for the values in range A3:L3 on sheet 1 in every
> workbook
> to be listed in order underneath each other on a single consolidation
> worksheet:-
>
> Ron De Bruin has lots of examples for this kind of thing on his
> website
>
> http://www.rondebruin.nl/tips.htm
>
> but if you give us some more detail then maybe we can give you more
> tailored
> advice
>
> --
> Regards
> Ken....................... Microsoft MVP - Excel
> Sys Spec - Win XP Pro / XL 97/00/02/03
>
> ------------------------------*------------------------------*----------------
> It's easier to beg forgiveness than ask permission :-)
> ------------------------------*------------------------------*----------------
Have you try the code ?
http://www.rondebruin.nl/copy3.htm
--
Regards Ron de Bruin
http://www.rondebruin.nl
"uberblah" <uberblah.1wtaib...@excelforum-nospam.com> wrote in message
news:uberblah.1wtaib...@excelforum-nospam.com...
Your code is very useful and it does do what I needed it to do;
however, I need to modify it to do 2 extra tasks and I'm new to VB
programming so I wondered if you could help.
1. I need the macro to crawl through directories. Maybe some sort of
recursion needs to be used? been so long since I've programmed :( My
files are contained in varius sub directories, and how deep they go may
vary. I need the macro to crawl through the main directory I point it
to and capture all the files in all the sub directories.
2. These spreadsheets I'm usings have 25 rows to them and not all rows
contain data; however, I need to get all those rows with data onto my
consolidated sheet. The rows are from rows A4 to A28. and the row
length is A4:AK.
I'm playing with your code as I write this but I don't know how
successfull I'm going to be considering I'm so rusty with programming
in general, let alone I've never touched VB. :eek:
The code from your website that I'm using is:
Copy a Range from each workbook
This example will copy Range("A1:J1") from the first sheet in each
workbook.
Change the folder "C:\Data" 0r "\\ComputerName\YourFolder" to your
folder.
Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
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
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 1
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A4:AK4")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")
basebook.Worksheets(1).Cells(rnum, "AL").Value = mybook.Name
' This will add the workbook name in column D if you want
sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only
the values
' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum,
"A"). _
' Resize(.Rows.Count,
.Columns.Count)
' End With
' destrange.Value = sourceRange.Value
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
See SearchSubFolders in the code
--
Regards Ron de Bruin
http://www.rondebruin.nl
"uberblah" <uberblah.1wwoqa...@excelforum-nospam.com> wrote in message
news:uberblah.1wwoqa...@excelforum-nospam.com...
Agian your code is informative and helpful. I modified it so I could
get every row in the spreadsheet because your original code only
returns the first row you point it to.
A feature I have been uccessfull with so far is to add the directory
name where the file is located into into the spreadsheet.
Below is the code I'm using. I have edited it down to 1 Case statement
so it's easyer to read. The case statements are what allowed me to
capture each row of the spreadsheets. I highlighted the psuedo code in
red which I want to use to capture the current directory that File is
in. Any ideas on how I can get this to work? I don't think there is
an option under Application.Filesearch to do this?
Sub File_crawl_consolodate_values()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim j As Long
Dim a As Long
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Data"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
For j = 1 To 1
Select Case j
Case 1
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange =
mybook.Worksheets(1).Range("A4:AK4")
a = sourceRange.Rows.Count
With sourceRange
Set destrange =
basebook.Worksheets(1).Cells(rnum, 1). _
Resize(.Rows.Count,
.Columns.Count)
End With
destrange.Value = sourceRange.Value
basebook.Worksheets(1).Cells(rnum, "A").Value =
Dir(CurrentFileDirectory, vbDirectory)
mybook.Close
rnum = rnum + a
End Select
Next j
Next i
End If
End With
End Sub
Ron de Bruin Wrote:
> Try if FileSearch is working for you
> http://www.rondebruin.nl/copy33.htm
>
> See SearchSubFolders in the code
>
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
Incidently if anyone cares, all you need to do is:
basebook.Worksheets(1).Cells(rnum, "A").Value = Dir(mybook.path,
vbDirectory)
> :) :) :)
I tried using your code, but it's only returning the 1st line in the
files. My range is from a1 to k1.
Help!
--
rehoboth123
------------------------------------------------------------------------
rehoboth123's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=28646