Hello

I have 10 files (1 per person- S:\data\(initials)) they have the same format
(1st four columns) with data in them with the first row as a header. I wish
to create 1 file for all this data, is there an easy way to obtain the data
from all the files and create a new one under S:\data\combined without having
to open then all 1 by one and copy and insert the cells into the new combined
file (the data range also changes on a day to day basis).

Please can you provide suggestions, thank you in advance for your help.

Regards.

Hi Nav,

See Ron de Bruin's sample code at:

Copy a range from closed workbooks (ADO)
http://www.rondebruin.nl/ado.htm



---
Regards,
Norman


"Nav" <(E-Mail Removed)> wrote in message
news:009C36FE-2233-440D-BB84-(E-Mail Removed)...
> Hello
>
> I have 10 files (1 per person- S:\data\(initials)) they have the same
> format
> (1st four columns) with data in them with the first row as a header. I
> wish
> to create 1 file for all this data, is there an easy way to obtain the
> data
> from all the files and create a new one under S:\data\combined without
> having
> to open then all 1 by one and copy and insert the cells into the new
> combined
> file (the data range also changes on a day to day basis).
>
> Please can you provide suggestions, thank you in advance for your help.
>
> Regards.

Hi Nav

you could try something like the following which will open each excel
file in a given directory and copy all the data in the first four
columns (except the header) and paste it in the workbook running the
code. it will then save a copy of the workbook in the desired
folder. Then close the workbook you ran the code from without saving.

add a module to a workbook then paste the following code into that
module, you can then trigger the macro by a keyboard shortcut or a
button ect.

Option Explicit
Dim MyFile As String
Dim MyWkBk As String
Dim Directory As String
Dim LstCell As String

Sub GetMyData()
MyWkBk = ActiveWorkbook.Name
Directory = "C:\Test\" 'change this to the directory for your files
MyFile = Dir(Directory & "\*.xls")
Do Until MyFile = ""
Workbooks.Open (Directory & MyFile)
LstCell = [A1].End(xlDown).Offset(0, 3).Address
Range("A2", LstCell).Copy
Workbooks(MyWkBk).Activate
If [A2].Value = "" Then
[A2].Activate
Else
[A2].End(xlDown).Offset(1, 0).Activate
End If
ActiveCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Workbooks(MyFile).Close (False)
MyFile = Dir
Loop

ActiveWorkbook.SaveCopyAs "S:\data\combined" 'this directory must
exist or it will give an error
End Sub


hope this gives you an idea of what to do

S

Hi Incidental,

I think that Nav was seeking not to open the source files.


---
Regards,
Norman



"Incidental" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi Nav
>
> you could try something like the following which will open each excel
> file in a given directory and copy all the data in the first four
> columns (except the header) and paste it in the workbook running the
> code. it will then save a copy of the workbook in the desired
> folder. Then close the workbook you ran the code from without saving.
>
> add a module to a workbook then paste the following code into that
> module, you can then trigger the macro by a keyboard shortcut or a
> button ect.
>
> Option Explicit
> Dim MyFile As String
> Dim MyWkBk As String
> Dim Directory As String
> Dim LstCell As String
>
> Sub GetMyData()
> MyWkBk = ActiveWorkbook.Name
> Directory = "C:\Test\" 'change this to the directory for your files
> MyFile = Dir(Directory & "\*.xls")
> Do Until MyFile = ""
> Workbooks.Open (Directory & MyFile)
> LstCell = [A1].End(xlDown).Offset(0, 3).Address
> Range("A2", LstCell).Copy
> Workbooks(MyWkBk).Activate
> If [A2].Value = "" Then
> [A2].Activate
> Else
> [A2].End(xlDown).Offset(1, 0).Activate
> End If
> ActiveCell.PasteSpecial xlPasteValues
> Application.CutCopyMode = False
> Workbooks(MyFile).Close (False)
> MyFile = Dir
> Loop
>
> ActiveWorkbook.SaveCopyAs "S:\data\combined" 'this directory must
> exist or it will give an error
> End Sub
>
>
> hope this gives you an idea of what to do
>
> S
>

Hi,

I think you can use something like this


Sub getData()

'On Error Resume Next

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

'put all the file names without extension
'into an array
initials = Array("XX", "XY", "XZ", "XA")

'overwrite existing combined.xls
Application.DisplayAlerts = False

'add header rows to combined.xls
Set combined = Workbooks.Add
With combined.Sheets(1)
..Cells(1, 1) = "first"
..Cells(1, 2) = "second"
..Cells(1, 3) = "third"
..Cells(1, 4) = "fourth"
End With

'save and close combined.xls
combined.SaveAs "S:\data\combined.xls"
combined.Close

'connect to combined.xls using ADO
Set CnnOut = CreateObject("ADODB.Connection")
Set rsOut = CreateObject("ADODB.Recordset")

CnnOut.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=S:\data\combined.xls;" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"

rsOut.Open "Select * FROM [Sheet1$]", _
CnnOut, adOpenStatic, adLockOptimistic, adCmdText

'loop through initials array
'to construct the appropriate file name
'XX.xls, XY.xls ...
For Each initial In initials

Set Cnn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")

Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=S:\data\" & initial & ".xls;" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"

'get the data from each .xls file
Rs.Open "Select * FROM [Sheet1$]", _
Cnn, adOpenStatic, adLockOptimistic, adCmdText

'write the data to combined.xls
Do Until Rs.EOF

rsOut.AddNew
rsOut!first = Rs!first
rsOut!Second = Rs!Second
rsOut!third = Rs!third
rsOut!fourth = Rs!fourth
rsOut.Update
Rs.MoveNext

Loop

'clean up for the next .xls file
Set Rs = Nothing
Set Cnn = Nothing

Next

'clean up for combined.xls
Set rsOut = Nothing
Set CnnOut = Nothing

End Sub


--
urkec


"Nav" wrote:

> Hello
>
> I have 10 files (1 per person- S:\data\(initials)) they have the same format
> (1st four columns) with data in them with the first row as a header. I wish
> to create 1 file for all this data, is there an easy way to obtain the data
> from all the files and create a new one under S:\data\combined without having
> to open then all 1 by one and copy and insert the cells into the new combined
> file (the data range also changes on a day to day basis).
>
> Please can you provide suggestions, thank you in advance for your help.
>
> Regards.

On 12 Apr, 17:21, "Norman Jones" <normanjo...@whereforartthou.com>
wrote:
> Hi Incidental,
>
> I think that Nav was seeking not to open the source files.
>
> ---
> Regards,
> Norman
>


Hi Norman

On reading it again your right norman, in my defence it was a very
sunny day yesterday and i did spend most of the day staring out the
window in a day dream waiting for 5pm to role around so i might not
have been paying attention to well lol

Steve

Thank you for this, but I keep getting a runtime 3265 error - "Item cannot be
found in the collection corresponding to the requested name or ordinal".

It keeps stopping for debug at the code:

rsOut!first = Rs!first

Thanks anyway.

"urkec" wrote:

> Hi,
>
> I think you can use something like this
>
>
> Sub getData()
>
> 'On Error Resume Next
>
> Const adOpenStatic = 3
> Const adLockOptimistic = 3
> Const adCmdText = &H1
>
> 'put all the file names without extension
> 'into an array
> initials = Array("XX", "XY", "XZ", "XA")
>
> 'overwrite existing combined.xls
> Application.DisplayAlerts = False
>
> 'add header rows to combined.xls
> Set combined = Workbooks.Add
> With combined.Sheets(1)
> .Cells(1, 1) = "first"
> .Cells(1, 2) = "second"
> .Cells(1, 3) = "third"
> .Cells(1, 4) = "fourth"
> End With
>
> 'save and close combined.xls
> combined.SaveAs "S:\data\combined.xls"
> combined.Close
>
> 'connect to combined.xls using ADO
> Set CnnOut = CreateObject("ADODB.Connection")
> Set rsOut = CreateObject("ADODB.Recordset")
>
> CnnOut.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=S:\data\combined.xls;" & _
> "Extended Properties=""Excel 8.0;HDR=Yes;"";"
>
> rsOut.Open "Select * FROM [Sheet1$]", _
> CnnOut, adOpenStatic, adLockOptimistic, adCmdText
>
> 'loop through initials array
> 'to construct the appropriate file name
> 'XX.xls, XY.xls ...
> For Each initial In initials
>
> Set Cnn = CreateObject("ADODB.Connection")
> Set Rs = CreateObject("ADODB.Recordset")
>
> Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=S:\data\" & initial & ".xls;" & _
> "Extended Properties=""Excel 8.0;HDR=Yes;"";"
>
> 'get the data from each .xls file
> Rs.Open "Select * FROM [Sheet1$]", _
> Cnn, adOpenStatic, adLockOptimistic, adCmdText
>
> 'write the data to combined.xls
> Do Until Rs.EOF
>
> rsOut.AddNew
> rsOut!first = Rs!first
> rsOut!Second = Rs!Second
> rsOut!third = Rs!third
> rsOut!fourth = Rs!fourth
> rsOut.Update
> Rs.MoveNext
>
> Loop
>
> 'clean up for the next .xls file
> Set Rs = Nothing
> Set Cnn = Nothing
>
> Next
>
> 'clean up for combined.xls
> Set rsOut = Nothing
> Set CnnOut = Nothing
>
> End Sub
>
>
> --
> urkec
>
>
> "Nav" wrote:
>
> > Hello
> >
> > I have 10 files (1 per person- S:\data\(initials)) they have the same format
> > (1st four columns) with data in them with the first row as a header. I wish
> > to create 1 file for all this data, is there an easy way to obtain the data
> > from all the files and create a new one under S:\data\combined without having
> > to open then all 1 by one and copy and insert the cells into the new combined
> > file (the data range also changes on a day to day basis).
> >
> > Please can you provide suggestions, thank you in advance for your help.
> >
> > Regards.

Hello - thank you for this.

But are you aware if there is anyway to copy the data from a range named
DATA (which is a dynamic range), as the code for below requires you to know
the exact range, I have tried substituting DATA into the code where the range
is stated but this does not work.

Thank you again for all your help.

"Norman Jones" wrote:

> Hi Nav,
>
> See Ron de Bruin's sample code at:
>
> Copy a range from closed workbooks (ADO)
> http://www.rondebruin.nl/ado.htm
>
>
>
> ---
> Regards,
> Norman
>
>
> "Nav" <(E-Mail Removed)> wrote in message
> news:009C36FE-2233-440D-BB84-(E-Mail Removed)...
> > Hello
> >
> > I have 10 files (1 per person- S:\data\(initials)) they have the same
> > format
> > (1st four columns) with data in them with the first row as a header. I
> > wish
> > to create 1 file for all this data, is there an easy way to obtain the
> > data
> > from all the files and create a new one under S:\data\combined without
> > having
> > to open then all 1 by one and copy and insert the cells into the new
> > combined
> > file (the data range also changes on a day to day basis).
> >
> > Please can you provide suggestions, thank you in advance for your help.
> >
> > Regards.
>
>
>