ExcelBanter - Macro to extract data from multiple Excel files

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Macro to extract data from multiple Excel files (https://www.excelbanter.com/excel-programming/440824-macro-extract-data-multiple-excel-files.html)

Macro to extract data from multiple Excel files

I have about 100 excel files that contains data in cells A1:B6 that I need to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to paste
to one file without copying over existing data. Can someone please help me
get going in the right direction. I would also be open to paste appending it
into Access if it's easier. Just let me know if you need more information.

Thanks,
Rich

Macro to extract data from multiple Excel files

You might want to check out some of Ron's merging examples he
http://www.rondebruin.nl/tips.htm

Under the section:
Copy/Paste/Merge examples

You might even be able to use the add-in:
http://www.rondebruin.nl/merge.htm

--
Best Regards,

Luke M
"Rich Young" wrote in message
...
I have about 100 excel files that contains data in cells A1:B6 that I need
to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to
paste
to one file without copying over existing data. Can someone please help
me
get going in the right direction. I would also be open to paste appending
it
into Access if it's easier. Just let me know if you need more
information.

Thanks,
Rich

Macro to extract data from multiple Excel files

'/=====================================
Sub PasteIt()
Dim dblLastRow As Double
Dim wkb_Copy2 As Workbook
Dim wks_Copy2 As Worksheet

'set up workbook / sheet to be copied to
Set wkb_Copy2 = Workbooks("MyCopy2Workbook.xls")
Set wks_Copy2 = wkb_Copy2.Worksheets("TheCopy2Worksheet")

'grab the data to be copied
Selection.Copy

'find out the last used row in the worksheet where the data
' is being copied to
dblLastRow = wks_Copy2.Cells.SpecialCells(xlLastCell).Row

'copy to 1 row below where the data ends [assume column A]
wks_Copy2.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

'empty memory
Set wks_Copy2 = Nothing
Set wkb_Copy2 = Nothing

End Sub
'/=====================================

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

I have about 100 excel files that contains data in cells A1:B6 that I need to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to paste
to one file without copying over existing data. Can someone please help me
get going in the right direction. I would also be open to paste appending it
into Access if it's easier. Just let me know if you need more information.

Thanks,
Rich

Macro to extract data from multiple Excel files

Thanks to both Luke and Gary. I'll look through those suggestions and will
let you know if I have any questions.

"Gary Brown" wrote:

'/=====================================
Sub PasteIt()
Dim dblLastRow As Double
Dim wkb_Copy2 As Workbook
Dim wks_Copy2 As Worksheet

'set up workbook / sheet to be copied to
Set wkb_Copy2 = Workbooks("MyCopy2Workbook.xls")
Set wks_Copy2 = wkb_Copy2.Worksheets("TheCopy2Worksheet")

'grab the data to be copied
Selection.Copy

'find out the last used row in the worksheet where the data
' is being copied to
dblLastRow = wks_Copy2.Cells.SpecialCells(xlLastCell).Row

'copy to 1 row below where the data ends [assume column A]
wks_Copy2.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

'empty memory
Set wks_Copy2 = Nothing
Set wkb_Copy2 = Nothing

End Sub
'/=====================================

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

I have about 100 excel files that contains data in cells A1:B6 that I need to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to paste
to one file without copying over existing data. Can someone please help me
get going in the right direction. I would also be open to paste appending it
into Access if it's easier. Just let me know if you need more information.

Thanks,
Rich

Macro to extract data from multiple Excel files

Hi Gary,

I'm was using your method from above but I have some difficutly pasting to a
new file. See my code below and let me know if I am doing something wrong.

Sub RunCodeOnAllXLSFiles()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wkbLastRow As Double
Dim wkb As Workbook
Dim wks As Worksheet

mycount = FoundFiles

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "G:\Fossil Departments\Financial Planning &
Analysis\Budgeting Group\Capital Expenditures\2010 CapEx\2010 CapEx Template
Submissions\Test"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"

If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

ActiveWorkbook.Unprotect Password:="java"
Sheets("Export Data").Visible = True
Range("A4").Select
ActiveCell.FormulaR1C1 = lCount
Range("A5").Select
ActiveWindow.SelectedSheets.Visible = False

' Set up workbook/sheet to be copied to
Set wkb = Workbooks("C:\CapEx_Consolidation.xls")
Set wks = wkb.Worksheets("CapEx_Consolidated")
Set wks = wkb.Worksheets

' Select data range to copy
Range("A4:AP12").Select
Selection.Copy

' Paste append to a spreadsheet (it finds the last used row and copies
to the next row)
wkbLastRow = wks.Cells.SpecialCells(xlLastCell).Row
wks.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

' empty memory
Set wks = Nothing
Set wkb = Nothing

ActiveWorkbook.Save
ActiveWorkbook.Close

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Sub Count()
mycount = Range("a1") + 1
Range("a1") = mycount
End Sub

Thanks again for your help

"Gary Brown" wrote:

'/=====================================
Sub PasteIt()
Dim dblLastRow As Double
Dim wkb_Copy2 As Workbook
Dim wks_Copy2 As Worksheet

'set up workbook / sheet to be copied to
Set wkb_Copy2 = Workbooks("MyCopy2Workbook.xls")
Set wks_Copy2 = wkb_Copy2.Worksheets("TheCopy2Worksheet")

'grab the data to be copied
Selection.Copy

'find out the last used row in the worksheet where the data
' is being copied to
dblLastRow = wks_Copy2.Cells.SpecialCells(xlLastCell).Row

'copy to 1 row below where the data ends [assume column A]
wks_Copy2.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

'empty memory
Set wks_Copy2 = Nothing
Set wkb_Copy2 = Nothing

End Sub
'/=====================================

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

I have about 100 excel files that contains data in cells A1:B6 that I need to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to paste
to one file without copying over existing data. Can someone please help me
get going in the right direction. I would also be open to paste appending it
into Access if it's easier. Just let me know if you need more information.

Thanks,
Rich

Macro to extract data from multiple Excel files

Rich,
Assuming you want to copy FROM 'Export Data' TO 'CapEx_Sonsolidated',
I would suggest the following changes to your code...
1) change...
wks.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll
to
wks.Range("A" & wkbLastRow + 1).PasteSpecial xlPasteAll
2) bring the Workbook and Worksheet SET statements up to the top
so the copy doesn't loose it's focus between copy and pasting
3) bring the copy statement up to BEFORE you make the sheet invisible
4) get rid of the statement...
Set wks = wkb.Worksheets
5) Remark out the line (optional)...
mycount = FoundFiles
- - - - - - - - - - - - - - - - - - -
Here's my code:
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wkbLastRow As Double
Dim wkb As Workbook
Dim wks As Worksheet

' mycount = foundfiles

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wbCodeBook = ThisWorkbook

' Set up workbook/sheet to be copied to
Set wkb = Workbooks("C:\CapEx_Consolidation.xls")
Set wks = wkb.Worksheets("CapEx_Consolidated")
Set wks = wkb.Worksheets

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = _
"G:\Fossil Departments\Financial Planning & " & _
"Analysis\Budgeting Group\Capital Expenditures\" & _
"2010 CapEx\2010 CapEx Template Submissions\Test"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"
If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .foundfiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = _
Workbooks.Open(Filename:=.foundfiles(lCount), _
UpdateLinks:=0)
ActiveWorkbook.Unprotect Password:="java"
Sheets("Export Data").Visible = True
Range("A4").Select
ActiveCell.FormulaR1C1 = lCount
Range("A5").Select

' Select data range to copy
Range("A4:AP12").Select
Selection.Copy

ActiveWindow.SelectedSheets.Visible = False

' Paste append to a spreadsheet (it finds the
' last used row and copies to the next row)
wkbLastRow = wks.Cells.SpecialCells(xlLastCell).Row
wks.Range("A" & wkbLastRow + 1).PasteSpecial xlPasteAll

' empty memory
Set wks = Nothing
Set wkb = Nothing

ActiveWorkbook.Save
ActiveWorkbook.Close

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
- - - - - - - - - - - - - - - - - - -

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

Hi Gary,

I'm was using your method from above but I have some difficutly pasting to a
new file. See my code below and let me know if I am doing something wrong.

Sub RunCodeOnAllXLSFiles()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wkbLastRow As Double
Dim wkb As Workbook
Dim wks As Worksheet

mycount = FoundFiles

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "G:\Fossil Departments\Financial Planning &
Analysis\Budgeting Group\Capital Expenditures\2010 CapEx\2010 CapEx Template
Submissions\Test"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"

If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

ActiveWorkbook.Unprotect Password:="java"
Sheets("Export Data").Visible = True
Range("A4").Select
ActiveCell.FormulaR1C1 = lCount
Range("A5").Select
ActiveWindow.SelectedSheets.Visible = False

' Set up workbook/sheet to be copied to
Set wkb = Workbooks("C:\CapEx_Consolidation.xls")
Set wks = wkb.Worksheets("CapEx_Consolidated")
Set wks = wkb.Worksheets

' Select data range to copy
Range("A4:AP12").Select
Selection.Copy

' Paste append to a spreadsheet (it finds the last used row and copies
to the next row)
wkbLastRow = wks.Cells.SpecialCells(xlLastCell).Row
wks.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

' empty memory
Set wks = Nothing
Set wkb = Nothing

ActiveWorkbook.Save
ActiveWorkbook.Close

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Sub Count()
mycount = Range("a1") + 1
Range("a1") = mycount
End Sub

Thanks again for your help

"Gary Brown" wrote:

'/=====================================
Sub PasteIt()
Dim dblLastRow As Double
Dim wkb_Copy2 As Workbook
Dim wks_Copy2 As Worksheet

'set up workbook / sheet to be copied to
Set wkb_Copy2 = Workbooks("MyCopy2Workbook.xls")
Set wks_Copy2 = wkb_Copy2.Worksheets("TheCopy2Worksheet")

'grab the data to be copied
Selection.Copy

'find out the last used row in the worksheet where the data
' is being copied to
dblLastRow = wks_Copy2.Cells.SpecialCells(xlLastCell).Row

'copy to 1 row below where the data ends [assume column A]
wks_Copy2.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

'empty memory
Set wks_Copy2 = Nothing
Set wkb_Copy2 = Nothing

End Sub
'/=====================================

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

I have about 100 excel files that contains data in cells A1:B6 that I need to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to paste
to one file without copying over existing data. Can someone please help me
get going in the right direction. I would also be open to paste appending it
into Access if it's easier. Just let me know if you need more information.

Thanks,
Rich

Macro to extract data from multiple Excel files

Works perfectly.....Thanks you so much for your help.

"Gary Brown" wrote:

Rich,
Assuming you want to copy FROM 'Export Data' TO 'CapEx_Sonsolidated',
I would suggest the following changes to your code...
1) change...
wks.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll
to
wks.Range("A" & wkbLastRow + 1).PasteSpecial xlPasteAll
2) bring the Workbook and Worksheet SET statements up to the top
so the copy doesn't loose it's focus between copy and pasting
3) bring the copy statement up to BEFORE you make the sheet invisible
4) get rid of the statement...
Set wks = wkb.Worksheets
5) Remark out the line (optional)...
mycount = FoundFiles
- - - - - - - - - - - - - - - - - - -
Here's my code:
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wkbLastRow As Double
Dim wkb As Workbook
Dim wks As Worksheet

' mycount = foundfiles

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wbCodeBook = ThisWorkbook

' Set up workbook/sheet to be copied to
Set wkb = Workbooks("C:\CapEx_Consolidation.xls")
Set wks = wkb.Worksheets("CapEx_Consolidated")
Set wks = wkb.Worksheets

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = _
"G:\Fossil Departments\Financial Planning & " & _
"Analysis\Budgeting Group\Capital Expenditures\" & _
"2010 CapEx\2010 CapEx Template Submissions\Test"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"
If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .foundfiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = _
Workbooks.Open(Filename:=.foundfiles(lCount), _
UpdateLinks:=0)
ActiveWorkbook.Unprotect Password:="java"
Sheets("Export Data").Visible = True
Range("A4").Select
ActiveCell.FormulaR1C1 = lCount
Range("A5").Select

' Select data range to copy
Range("A4:AP12").Select
Selection.Copy

ActiveWindow.SelectedSheets.Visible = False

' Paste append to a spreadsheet (it finds the
' last used row and copies to the next row)
wkbLastRow = wks.Cells.SpecialCells(xlLastCell).Row
wks.Range("A" & wkbLastRow + 1).PasteSpecial xlPasteAll

' empty memory
Set wks = Nothing
Set wkb = Nothing

ActiveWorkbook.Save
ActiveWorkbook.Close

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
- - - - - - - - - - - - - - - - - - -

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

Hi Gary,

I'm was using your method from above but I have some difficutly pasting to a
new file. See my code below and let me know if I am doing something wrong.

Sub RunCodeOnAllXLSFiles()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim wkbLastRow As Double
Dim wkb As Workbook
Dim wks As Worksheet

mycount = FoundFiles

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "G:\Fossil Departments\Financial Planning &
Analysis\Budgeting Group\Capital Expenditures\2010 CapEx\2010 CapEx Template
Submissions\Test"
.FileType = msoFileTypeExcelWorkbooks
'.Filename = "Book*.xls"

If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults =
Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

ActiveWorkbook.Unprotect Password:="java"
Sheets("Export Data").Visible = True
Range("A4").Select
ActiveCell.FormulaR1C1 = lCount
Range("A5").Select
ActiveWindow.SelectedSheets.Visible = False

' Set up workbook/sheet to be copied to
Set wkb = Workbooks("C:\CapEx_Consolidation.xls")
Set wks = wkb.Worksheets("CapEx_Consolidated")
Set wks = wkb.Worksheets

' Select data range to copy
Range("A4:AP12").Select
Selection.Copy

' Paste append to a spreadsheet (it finds the last used row and copies
to the next row)
wkbLastRow = wks.Cells.SpecialCells(xlLastCell).Row
wks.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

' empty memory
Set wks = Nothing
Set wkb = Nothing

ActiveWorkbook.Save
ActiveWorkbook.Close

Next lCount
End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Sub Count()
mycount = Range("a1") + 1
Range("a1") = mycount
End Sub

Thanks again for your help

"Gary Brown" wrote:

'/=====================================
Sub PasteIt()
Dim dblLastRow As Double
Dim wkb_Copy2 As Workbook
Dim wks_Copy2 As Worksheet

'set up workbook / sheet to be copied to
Set wkb_Copy2 = Workbooks("MyCopy2Workbook.xls")
Set wks_Copy2 = wkb_Copy2.Worksheets("TheCopy2Worksheet")

'grab the data to be copied
Selection.Copy

'find out the last used row in the worksheet where the data
' is being copied to
dblLastRow = wks_Copy2.Cells.SpecialCells(xlLastCell).Row

'copy to 1 row below where the data ends [assume column A]
wks_Copy2.Range("A" & dblLastRow + 1).PasteSpecial xlPasteAll

'empty memory
Set wks_Copy2 = Nothing
Set wkb_Copy2 = Nothing

End Sub
'/=====================================

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

"Rich Young" wrote:

I have about 100 excel files that contains data in cells A1:B6 that I need to
extract out in to a separate single excel file. I have already created a
macro that runs through each file within a specified folder, opens it,
selects the range and copies it but I not really sure how to get it to paste
to one file without copying over existing data. Can someone please help me
get going in the right direction. I would also be open to paste appending it
into Access if it's easier. Just let me know if you need more information.

Thanks,
Rich