I need to write some kind of macro or other kind of script to do the following;

I have a folder with around 30 excel files, all in the same format with 2
columns.

I want to be able to run something to add them all together into one excel
spreadsheet, so that one is pasted after the other, so the first file is put
in their, then the next file is pasted in the first empty cell after that and
so on.

Is this possible?

Hi Martina,

See Ron De Bruin's Web page:

http://www.rondebruin.nl/copy3.htm#Range


---
Regards,
Norman



"MartinaL" wrote in message
...
I need to write some kind of macro or other kind of script to do the
following;

I have a folder with around 30 excel files, all in the same format with 2
columns.

I want to be able to run something to add them all together into one excel
spreadsheet, so that one is pasted after the other, so the first file is
put
in their, then the next file is pasted in the first empty cell after that
and
so on.

Is this possible?

Okay I've read through this and I have kind of found the code that I need,
but in this section how do I change it so instead of selecting specific cells
it selects all used cells?

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
Set sourceRange = mybook.Worksheets(1).range("A1:C5")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).range("A" & rnum)

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

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

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum

"Norman Jones" wrote:

Hi Martina,

See Ron De Bruin's Web page:

http://www.rondebruin.nl/copy3.htm#Range


---
Regards,
Norman



"MartinaL" wrote in message
...
I need to write some kind of macro or other kind of script to do the
following;

I have a folder with around 30 excel files, all in the same format with 2
columns.

I want to be able to run something to add them all together into one excel
spreadsheet, so that one is pasted after the other, so the first file is
put
in their, then the next file is pasted in the first empty cell after that
and
so on.

Is this possible?

Hi Martina,

Assuming the two columns you want to copy are columns A and B, try changing:

Set sourceRange = mybook.Worksheets(1).range("A1:C5")

to:

With MyBook.Worksheets(1)
Set SourceRange = Intersect(.UsedRange, .Columns("A:B"))
End With


Regards,
Norman



"MartinaL" wrote in message
...
Okay I've read through this and I have kind of found the code that I need,
but in this section how do I change it so instead of selecting specific
cells
it selects all used cells?

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
Set sourceRange = mybook.Worksheets(1).range("A1:C5")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).range("A" & rnum)

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

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

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum

"Norman Jones" wrote:

Hi Martina,

See Ron De Bruin's Web page:

http://www.rondebruin.nl/copy3.htm#Range


---
Regards,
Norman



"MartinaL" wrote in message
...
I need to write some kind of macro or other kind of script to do the
following;

I have a folder with around 30 excel files, all in the same format with
2
columns.

I want to be able to run something to add them all together into one
excel
spreadsheet, so that one is pasted after the other, so the first file
is
put
in their, then the next file is pasted in the first empty cell after
that
and
so on.

Is this possible?

Hi Martina,

Apologies for the delay in reponding to your last post. My newsreader
dropped the post and I only spotted it while googling.

The reason that your code is producing a blank summary workbook is that you
have commented out the destination range, thus:

' With sourceRange ' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count) ' End With ' destrange.Value =
sourceRange.Value

Replace your code with the following:

'==================================
Sub Merge2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim LRow As Long

'Fill in the path\folder where the files are
'MyPath = "C:\Data" or on a network :
MyPath = "\\hvws13\c$\Program Files\CA\" & _
"eTrust Antivirus\DB\" & _
"Excel Files\June05" '<<=== CHECK SPACE after Excel!!!

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the _
'folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
rnum = 1

'Fill the array(myFiles)with the list _
'of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To _
UBound(MyFiles)
Set mybook = Workbooks.Open _
(MyPath & MyFiles(Fnum))

LRow = MyLastRow(mybook.Worksheets(1))

With mybook.Worksheets(1)
Set sourceRange = Range("A1:B" & LRow)
End With

SourceRcount = sourceRange.Rows.Count
Set destrange = basebook. _
Worksheets(1).Range("A" & rnum)

sourceRange.Copy destrange

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

'<<==================================

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

'<<==================================

Please carefully check the line:

MyPath = "\\hvws13\c$\Program Files\CA\" & _
"eTrust Antivirus\DB\" & _
"Excel Files\June05" '

in the above code as, due to line wrap, I was unable to verify if there
should be a space between 'Excel' and 'Files.

---
Regards,
Norman

I have copy and pasted this exactly (except for the location of my excel
files where I checked the path was correct).

It obviously is because it opens all the files and closes then really
quickly but still nothing is pasted into my blank worksheet.

What am I doing wrong?

Also in Columns A and C are the one's with data in them, B is empty but I
need to copy this empty cell as well so that all three are copied to the new
folder

"Norman Jones" wrote:

Hi Martina,

Apologies for the delay in reponding to your last post. My newsreader
dropped the post and I only spotted it while googling.

The reason that your code is producing a blank summary workbook is that you
have commented out the destination range, thus:

' With sourceRange ' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count) ' End With ' destrange.Value =
sourceRange.Value

Replace your code with the following:

'==================================
Sub Merge2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim LRow As Long

'Fill in the path\folder where the files are
'MyPath = "C:\Data" or on a network :
MyPath = "\\hvws13\c$\Program Files\CA\" & _
"eTrust Antivirus\DB\" & _
"Excel Files\June05" '<<=== CHECK SPACE after Excel!!!

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the _
'folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
rnum = 1

'Fill the array(myFiles)with the list _
'of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To _
UBound(MyFiles)
Set mybook = Workbooks.Open _
(MyPath & MyFiles(Fnum))

LRow = MyLastRow(mybook.Worksheets(1))

With mybook.Worksheets(1)
Set sourceRange = Range("A1:B" & LRow)
End With

SourceRcount = sourceRange.Rows.Count
Set destrange = basebook. _
Worksheets(1).Range("A" & rnum)

sourceRange.Copy destrange

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

'<<==================================

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

'<<==================================

Please carefully check the line:

MyPath = "\\hvws13\c$\Program Files\CA\" & _
"eTrust Antivirus\DB\" & _
"Excel Files\June05" '

in the above code as, due to line wrap, I was unable to verify if there
should be a space between 'Excel' and 'Files.

---
Regards,
Norman