Good day to all:
I have a problem. Found a code created by Tom Ogilvy on a website:
But the code works well for 2003, but it does not work when I put it in a 2010 file. I did some research, and found that the "Filesearch" function does work in 2010 (or maybe I don't know how to get it to work).
This is the code. Can someone help me in amending the code, or providing a different way of achieving a smooth running code?
Sub RunCodeOnAllFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sh As Worksheet, r As Range
Dim sh1 As Worksheet, r1 As Range
' place data in the first sheet in the tab order for the
' workbook that holds the code - alter to fit your actual
' situation
Set sh = ThisWorkbook.Worksheets(1)
sh.Cells.ClearContents
'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 = "C:\Users\owner\Desktop\CSVFile"
'.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
.Filename = "*.csv"
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)
Set sh1 = wbResults.Worksheets(1)
Set r1 = sh1.Range("A1", sh1.Cells(sh1.Rows.Count, "A").End(xlUp))
Set r = sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
r1.Resize(, 15).Copy
r.PasteSpecial xlValues
Application.CutCopyMode = False
wbResults.Close SaveChanges:=False
'Clear clip board
Next lCount
End If
End With
On Error GoTo 0
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
'Application.EnableEvents = True
End Sub
Bookmarks