starsky
09-25-2009, 03:44 AM
Hi,
I've just noticed that some data in a particular range in workbooks I applied a macro to has disapppeared. The only delete reference in the macro is for a defined name, would this have done it??
Thanks.
Sub SbFdrCollate()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "S:\Folder\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For lCount = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'code to apply to found workbooks
ActiveWorkbook.Names("Drop").Delete
ActiveSheet.Unprotect Password:="xxx"
Cells.Locked = True
ActiveWindow.FreezePanes = False
Columns.Hidden = False
Range("A12:I100", ActiveCell.SpecialCells(xlLastCell)).Copy
Workbooks("Test.xls").Sheets("Data").Activate
Range("A2").Select
'finds next blank row, pastes, etc
If Range("A2") = "" Then
ActiveSheet.Paste
Else
Selection.End(xlDown).Select
With ActiveCell
Cells(.Row + 1, .Column).Select
End With
ActiveSheet.Paste
End If
'end of code to apply to found workbooks
With Cells
.Font.Size = 8
.EntireColumn.AutoFit
End With
wbResults.Close savechanges:=True
Next lCount
End If
End With
End Sub
I've just noticed that some data in a particular range in workbooks I applied a macro to has disapppeared. The only delete reference in the macro is for a defined name, would this have done it??
Thanks.
Sub SbFdrCollate()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "S:\Folder\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For lCount = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'code to apply to found workbooks
ActiveWorkbook.Names("Drop").Delete
ActiveSheet.Unprotect Password:="xxx"
Cells.Locked = True
ActiveWindow.FreezePanes = False
Columns.Hidden = False
Range("A12:I100", ActiveCell.SpecialCells(xlLastCell)).Copy
Workbooks("Test.xls").Sheets("Data").Activate
Range("A2").Select
'finds next blank row, pastes, etc
If Range("A2") = "" Then
ActiveSheet.Paste
Else
Selection.End(xlDown).Select
With ActiveCell
Cells(.Row + 1, .Column).Select
End With
ActiveSheet.Paste
End If
'end of code to apply to found workbooks
With Cells
.Font.Size = 8
.EntireColumn.AutoFit
End With
wbResults.Close savechanges:=True
Next lCount
End If
End With
End Sub