Expansion on Previous request - Scan sheet for empty rows, return values for specific empty rows for an entire sheet, move to next sheet and repeat, l

[ExcelGuy13]

So I'm hoping to extend the functionality of a request I made here previously at the following link: http://www.mrexcel.com/forum/excel-...column-b-over-move-data-column-sheet-2-a.html

My Aswer is this gave me a perfectly working bit of VB code, but now I'm trying to expand on the functionality and hoping somebody can help.

So almost the exact same concept, the original question was for the VB to scan the original sheet and dump names based on the criteria to a new sheet, but now i've got multiple sheets and want to scan them individually and dump all the results to one sheet, but I want to break up the results by sheet with a color coded label and a blank row. Basically sheet 1 will be where the results show up, and what I need is for excel move to sheet 2 and scan each row starting with row 7 and if every column (excluding A) is empty, then take the value in column a of that row and paste it into the next available space on sheet 1. Continue doing this until the bottom sheet 2, then on sheet 1 add a space and then label it based on the next sheet (and color code) and then move to sheet 3 and repeat the process. This will continue for several sheets (8 or 9 sheets) all dumping back to sheet 1. I recognize my descriptions aren't the best so I've included some screen shots of what I'm trying to accomplish and hopefully somebody can help me make this process MUCH MUCH easier rather than doing this manually on a regular basis. As always THANK YOU and thank you again to 'My Aswer is this' who got me a working project I'm just trying to clean it up and expand on it since the requirements have changed.

Sheet 1:

Sheet 2:

Sheet 3:

Sheet 1 after VB has run:

 

[RCBricker]

So I'm hoping to extend the functionality of a request I made here previously at the following link: http://www.mrexcel.com/forum/excel-...column-b-over-move-data-column-sheet-2-a.html

My Aswer is this gave me a perfectly working bit of VB code, but now I'm trying to expand on the functionality and hoping somebody can help.

So almost the exact same concept, the original question was for the VB to scan the original sheet and dump names based on the criteria to a new sheet, but now i've got multiple sheets and want to scan them individually and dump all the results to one sheet, but I want to break up the results by sheet with a color coded label and a blank row. Basically sheet 1 will be where the results show up, and what I need is for excel move to sheet 2 and scan each row starting with row 7 and if every column (excluding A) is empty, then take the value in column a of that row and paste it into the next available space on sheet 1. Continue doing this until the bottom sheet 2, then on sheet 1 add a space and then label it based on the next sheet (and color code) and then move to sheet 3 and repeat the process. This will continue for several sheets (8 or 9 sheets) all dumping back to sheet 1. I recognize my descriptions aren't the best so I've included some screen shots of what I'm trying to accomplish and hopefully somebody can help me make this process MUCH MUCH easier rather than doing this manually on a regular basis. As always THANK YOU and thank you again to 'My Aswer is this' who got me a working project I'm just trying to clean it up and expand on it since the requirements have changed.

Sheet 1:

Sheet 2:

Sheet 3:

Sheet 1 after VB has run:

don't have your original code so had to write that myself. You can use what I wrote or call the other subroutine

Sub MULTI_List()

Dim lngROW As Long, lngROWst As Long, lngCOL As Long, lngLROW As Long
Dim rng As Range, rngLIST As Range, cell As Range, rngPASTE As Range
Dim ws As Worksheet, wsLIST As Worksheet
Dim intCNT As Integer
Dim varI As Variant
    Set wsLIST = Sheets("Lists")
    
    For Each ws In Worksheets
        If Not ws.Name = "Lists" Then
            ws.Select
            With ws
                varI = 0
                lngROW = Range("A" & .ROWS.Count).End(xlUp).Row
                lngROWst = Range("A" & .ROWS.Count).End(xlUp). _
                    End(xlUp).Offset(-1).Row
                lngCOL = Cells(lngROWst, .Columns.Count).End(xlToLeft).Column
                Set rngLIST = Range(.Cells(lngROWst + 1, 1), .Cells(lngROW, 1))
                For Each cell In rngLIST
                    Set rng = Range(.Cells(cell.Row, 2), _
                        .Cells(cell.Row, lngCOL))
                    intCNT = WorksheetFunction.CountA(rng)
                    If intCNT = 0 Then
                        'Call your VB SCRIPT that moves the DATA
                        ' or use the one below
                        cell.Copy
                        wsLIST.Select
                        With wsLIST
                            lngLROW = Range("A" & .ROWS.Count).End(xlUp).Row
                            Set rngPASTE = Range("A" & lngLROW)
    
                            If rngPASTE.Value = "Names:" Then
                                Set rngPASTE = rngPASTE.Offset(1)
                                rngPASTE.Value = ws.Name
                                varI = 1
                            Else
                                If varI = 0 Then
                                    Set rngPASTE = rngPASTE.Offset(2)
                                    rngPASTE.Value = ws.Name
                                    varI = 1
                                End If
                            End If
                            Set rngPASTE = rngPASTE.Offset(1)
                            rngPASTE.PasteSpecial xlPasteAll
                            ws.Select
                        End With
                    End If
                Next cell
            End With
        End If
    Next ws
End Sub