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 said:
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 said:
'/=====================================
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
:
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
