View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Rich Young Rich Young is offline
external usenet poster
 
Posts: 7
Default 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