Excel Macro or other script
 

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?

Excel Macro or other script
 

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?

Excel Macro or other script
 

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?

Excel Macro or other script
 

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?

Excel Macro or other script
 

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

Excel Macro or other script
 

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

Excel Macro or other script
 

Hi Martina,

I originally created a directory and populated it with some dummy files to
test the code; I have now retested. Each test was successful.

So, consider what could go wrong:-

1) There might be no files to copy or your path might be incorrect.
This looks unlikely because :

It obviously is because it opens all the files and closes then really
quickly


Although, with ScreenUpdating set to false, I would not expect this; you
may, however, be running the sub from the VBE, which would explain the
screen refreshes.


2) There may be nothing to copy on Worksheet(1). Or, Worksheet(1) may not be
the sheet that you expect it to be. You could open one of the 30+ files to
check these points. For the latter point, with the file open, in the VBE
intermediate window type:
?Activeworkbook.Sheets(1).Name
and check the response.


3) The data may in fact be copied, but not where you expect. As written,
data is copied to Worksheet(1) of the Workbook which holds the Merge2 macro;
this may or may *not* be the *active* workbook. You can also check, as
before, that Worksheet(1), in the book holding the code, is what you
expect it to be.


If the preceding has not helped, comment out the
Application.ScreenUpdating = False
line and (in the VBE) with the cursor somewhere in the Merge2 macro, press
the F8 function key to step through the macro.

If you need more help at this point, please post back.


---
Regards,
Norman




"MartinaL" wrote in message
...
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

Excel Macro or other script
 

Okay, none of these things seemed to help so I did the last step and stepped
through the code, it seems to get stuck here;

What I found was that at this stage in the code;

If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
With mybook.Worksheets(1)
Set sourceRange = Intersect(.UsedRange, .Columns("A:B"))
End With
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

When it gets to mybook.close savechanges:=false it opens up Sheet1 of
personal.xls which is where I have my macro saved.

How do I get around this so that it puts the data into the active workbook?

"Norman Jones" wrote:

Hi Martina,

I originally created a directory and populated it with some dummy files to
test the code; I have now retested. Each test was successful.

So, consider what could go wrong:-

1) There might be no files to copy or your path might be incorrect.
This looks unlikely because :

It obviously is because it opens all the files and closes then really
quickly


Although, with ScreenUpdating set to false, I would not expect this; you
may, however, be running the sub from the VBE, which would explain the
screen refreshes.


2) There may be nothing to copy on Worksheet(1). Or, Worksheet(1) may not be
the sheet that you expect it to be. You could open one of the 30+ files to
check these points. For the latter point, with the file open, in the VBE
intermediate window type:
?Activeworkbook.Sheets(1).Name
and check the response.


3) The data may in fact be copied, but not where you expect. As written,
data is copied to Worksheet(1) of the Workbook which holds the Merge2 macro;
this may or may *not* be the *active* workbook. You can also check, as
before, that Worksheet(1), in the book holding the code, is what you
expect it to be.


If the preceding has not helped, comment out the
Application.ScreenUpdating = False
line and (in the VBE) with the cursor somewhere in the Merge2 macro, press
the F8 function key to step through the macro.

If you need more help at this point, please post back.


---
Regards,
Norman




"MartinaL" wrote in message
...
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