G
Guest
I would tremendously appreciate help in coding a deletion of all blank rows
from all worksheets in all files within a certain directory.
I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.
I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!
Sub DeleteEmptyRows()
Dim LastRow As Long, r As Long
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
Application.ScreenUpdating = True
End Su
************************************************************************************************************************************************************************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).Offset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Basebook.SaveAs Application.GetSaveAsFilename
End Sub
from all worksheets in all files within a certain directory.
I have code that merges multiple documents but I found that any blank row
will stop the merge at that point. The number of documents makes manual
deletion too costly in terms of time and effort.
I found the following code elsewhere for deleting blanks from a single
worksheet...can anyone tell me how to generalize this to multiple sheets &
multiple documents? Below I will include the code I have both for deleting
empty rows from a single sheet and for combining multiple sheets/documents.
I'll separate with a big ************************. Thanks!!!!
Sub DeleteEmptyRows()
Dim LastRow As Long, r As Long
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
Application.ScreenUpdating = True
End Su
************************************************************************************************************************************************************************************
Sub ConsolidateWithLabels()
' Will consolidate Mulitple Sheets
' from Multiple Files onto one sheet
' Never tested with files that would
' give more than one sheets as end result
' Assumes that all data starts in cell A1 and
' is contiguous, with no blanks in column A
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
For Each mySheet In myBook.Worksheets
mySheet.Activate
Range("A1").CurrentRegion.Copy _
Basebook.Worksheets(1).Range("C65536").End(xlUp).Offset(1, 0)
With Basebook.Worksheets(1)
.Range(.Range("A65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -2)).Value = _
myBook.Name
.Range(.Range("B65536").End(xlUp).Offset(1, 0), _
.Range("C65536").End(xlUp).Offset(0, -1)).Value = _
mySheet.Name
End With
Next mySheet
myBook.Close
End If
Next i
End If
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
Basebook.SaveAs Application.GetSaveAsFilename
End Sub