merge files and copy to database

[as_sass]

Hi!

this builds on a previous post (see below), it's response to it, as well as a tip I obtained using the search funtion on exceltip.com.

I would like to merge all files in a directory and paste the one row of data from each file (range always the same) into a database. Obviously, the data should not be overwritten each time, but the macro should add a row to the database for every file in the directory.

I found this pretty helpful tip for achieving somethin similar with the different workbooks of one workbook (see below).

I also found a previous question and reply that describes the merging (yet not the adding of rows).

Is there a way to combine the two?

Let's say my files to merge are called "person1.xls", "person2.xls", etc..
The row to copy is row 2 in sheet "score".
The database file is calles"database.xls".
The sheet it should be copied to is "all cases".


I really appreciate all the help/hints you can give me!

Thanks!

as


************THIS IS THE POST I FOUND*****(see below for tip)*****

I'll assume you can place all these files in the same
directory and a master file there too to receive all the
data. The following code placed in a module of the
master file with your addition of Copy and Copy To range
definitions should help get you there. Check the help
system for the Dir function to see how this will step
through all .xls files in the directory (There's a sample
there somewhat similar to the following).

Your "files that are setup the same(col & rows)" leads me
to think you can take it from here.

Sub MergeFiles()
Dim CurFile As String, CopyRng As Range, _
CopyToRng As Range
ChDir ThisWorkbook.Path
CurFile = Dir("*.xls")
Do While CurFile <> "" and CurFile <>
ThisWorkbook.Name
Workbooks.Open CurFile

Set CopyRng = '<<<<You Define the range to be
'copied from each workbook here. It
'could be complicated to do this if the
'range is not identical in each of the
'source workbooks.
Set CopyToRng = '<<<<You define the range to
'receive the copied data from CurFile
'here. You will have to work out some
'logic to shift this range definition
'between source files so as not to
'overwrite prior data."
CopyRng.Copy Destination:=CopyToRng

Workbooks(CurFile).Close savechanges:=False
CurFile = Dir ' Get next entry.
Loop
Set CopyRng = Nothing: Set CopyToRng = Nothing
End Sub

Best Regards,
Walt Weber
>-----Original Message-----
>I have 354 Excel files that are setup the same(col &
rows). How do I loop
>thru all files, extract data and copy to a Master
worksheet? Number of rows
>is not an issue.
>.
>

******************this is the tip*********************
VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel

CATEGORY: Cells, Ranges, Rows, and Columns in VBA VERSIONS: All Microsoft Excel Versions
The example codes will copy to a database sheet with the name Sheet2.
Every time you run one of the subs the cells will be placed below the last row with data or after the last Column with data in sheet2.
For each example there is a macro that does a normal copy and one that is only Copy the Values.
The Example subs use the functions below (the macros won’t work without the functions).


Sub CopyRow()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Rows("1:1")
Set destrange = Sheets("Sheet2").Rows(Lr)
sourceRange.Copy destrange
End Sub

Sub CopyRowValues()
Dim sourceRange As Range
Dim destrange As Range
Dim Lr As Long
Lr = LastRow(Sheets("Sheet2")) + 1
Set sourceRange = Sheets("Sheet1").Rows("1:1")
Set destrange = Sheets("Sheet2").Rows(Lr). _
Resize(sourceRange.Rows.Count)
destrange.Value = sourceRange.Value
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

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

[as_sass]

Guys,

You have always been so helpful, and I can't believe nobody can solve this problem!

Did I not give enough information, or did nobody see this, or... ?

Any help is appreciated, really!

as