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
|