Macro to extract data from multiple Excel files [Programming]

Prev: e-mail issue
Next: How to make weekly totals change as the days in the week change ye

From: Gary Brown on 22 Mar 2010 11:34

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

From: Gary Brown on 22 Mar 2010 11:36

From: Rich Young on 23 Mar 2010 14:42

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

First | Prev |
Pages: 1 2
Prev: e-mail issue
Next: How to make weekly totals change as the days in the week change ye