Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
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 Sub ************************************************** ************************************************** ************************************************** ****************************** 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).O ffset(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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
In Office 2000, How do I delete multiple blank rows at one time? | Excel Worksheet Functions | |||
insert or delete rows across multiple worksheets? | Excel Discussion (Misc queries) | |||
Can I delete multiple blank rows collectively? | Excel Worksheet Functions | |||
I want to delete multiple blank rows from a spreadsheet | New Users to Excel | |||
delete rows from multiple worksheets | Excel Worksheet Functions |