Copy Specific Rows from Multiple Sheets to One Summary Sheet in Excel 1

[vlbridge]

Good Morning!

I have been given an Excel file that was already created from our safety department. It is going to be used for audits. There are multiple sheets in this file. The safety manager wants a button on the last sheet that the crew can click to "Finalize the Audit". He wants this button to create a new sheet that contains all the rows from all the sheets that have data entered into them. The columns in each sheet are as follows:
Item
Reference
Description
Condition
Comments
Priority
Corrected

The first 3 are already filled out. If the vessel puts anything into any of the other columns, that whole row should copy to the new sheet, but the rows that are unchanged should not.

I am attaching a copy of the file to this post. Any help would be appreciated. What's really throwing me off is how some sheets contain more than one table of information.

Thank you in advance for your help!

 

[SkipVought]

hi,

Are all the columns in every sheet identical?

If the columns are not identical, then you do they get places on the summary sheet?

Does the data from each sheet ALSO get some identifier related to the source sheet in the summary sheet?

BTW, many of us that work in large companies, are restricted from downloading data, by company restrictions.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

The columns in every sheet have the same headers, yes. However, some sheets have more than one table of information. It's still the same headers, but multiple times in the sheet.

He didn't say that it needed an identifier as to which sheet it came from. It has the item and reference number already listed in the row so I don't think that would be needed.

I apologize that you can't download the file. I'm not sure how else to attach it. I can e-mail it to you if you'd like to look at it. Let me know. Thanks for your time.

 

[SkipVought]

Are the multiple tables in the same columns?

Do ANY tables have headings?

Do the multiple tables EACH have headings?

When there are multiple tables, what separates each table?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

The multiple tables are in the same columns with the same headers. For instance, one sheet is named "Second Deck". The first table has a merged cell across the top that says "Interior". The row below that has the column headers listed in my first post. The rows below that list each item in the audit. Then there are 4 rows where they can enter "Additional Notes". Right below that there's another merged cell that says "Exterior". Below that are the column headers repeated. Below that are more items for the audit. Below that is another section for additional comments.

 

[SkipVought]

Then there are 4 rows where they can enter "Additional Notes".

Do these rows also get copied?

If so. how do they line up with the existing columns?

BTW, the MERGE feature is a nasty, annoying feature that really messes up table features.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

ii36250

at

bellhelicopter

dot

textron

dot

com

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

He didn't mention that the additional notes would need to be copied over. He just said the rows that were changed. I guess it would be nice to have the notes brought over as well, but that would be getting really messy.

I don't know who set up this file, but these tables aren't even formatted as tables. It looks like someone just typed information into this and now he wants me to make magic happen with it.

What's the last reply you posted about?

 

[SkipVought]

Try this before you try sending to my eMail.

Paste this code in a MODULE in a COPY of your workbook. The run it from the Macros menu.

This assumes that the summary sheet is named, [highlight]Summary[/highlight]

Sub test()
    Dim ws As Worksheet, wsSummary As Worksheet, lRow As Long, bCOPY As Boolean
    
    Set wsSummary = Sheets("[highlight]Summary[/highlight]")
    
    For Each ws In Worksheets
        With ws
            Select Case .Name
                Case wsSummary.Name
                    bCOPY = False
                Case Else
                    bCOPY = True
                    If lRow = 0 Then
                        lRow = 1
                    Else
                        lRow = wsSummary.UsedRange.Rows.Count + 1
                    End If
            End Select
            
            If bCOPY Then
                .UsedRange.Copy
                wsSummary.Cells(lRow, "A").PasteSpecial xlPasteAll
            End If
        End With
    Next
    
    Set wsSummary = Nothing
End Sub

Now this does not do EVERYTHING you want. However, you can either manually delete the unwanted rows in the Summary sheet, using the AutoFilter OR you could record a macro to clean up the sheet.

Check it out and see if you can use it.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

Ok... we are getting somewhere now. That basically copied every sheet into the summary sheet. Now, could you add something that would delete all the rows that are blank in column D? I think that would do the trick. It would still leave all the headers, but at least it would have all the information he wants.

 

[SkipVought]

Now, could you add something that would delete all the rows that are blank in column D?

We are going to have YOU do that.

1. Turn on your Macro Recorder

2. SELECT column D

3. Turn on the AutoFilter

4. Select (Blank) in the Column D AutoFilter

5. Select the displayed DATA ROWS (the ROWS not the data in the rows)

6. Right-Click DELETE

7. Remove the Filter

8. Turn off the Macro Recorder.

Post back with your recorded code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

Below is the code I got from recording the macro as you said. Very cool. Thanks! I will play around with it some...add some information and check with him to be sure this is what he wants. I'm not sure how to post the code the way you did in your post. How do you do that?

Sub DeleteBlanks
'
' DeleteBlanks Macro
'

'
Columns("D").Select
Selection.AutoFilter
ActiveSheet.Range("$D$1:$D$897").AutoFilter Field:=1, Criteria1:="="
Rows("2:897").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$D$1:$D$36").AutoFilter Field:=1
End Sub

 

[SkipVought]

search for [highlight]Process TGML[/highlight] ON THIS PAGE.

In there is the [ignore]

...

[/ignore] TAG

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Sub test()
    Dim ws As Worksheet, wsSummary As Worksheet, lRow As Long, bCOPY As Boolean
    
    Set wsSummary = Sheets("Summary")
    
    For Each ws In Worksheets
        With ws
            Select Case .Name
                Case wsSummary.Name
                    bCOPY = False
                Case Else
                    bCOPY = True
                    If lRow = 0 Then
                        lRow = 1
                    Else
                        lRow = wsSummary.UsedRange.Rows.Count + 1
                    End If
            End Select
            
            If bCOPY Then
                .UsedRange.Copy
                wsSummary.Cells(lRow, "A").PasteSpecial xlPasteAll
            End If
        End With
    Next
    [b]
    DeleteBlanks
    [/b]
    Set wsSummary = Nothing
End Sub


Sub DeleteBlanks()
'
' DeleteBlanks Macro
'

'
    With Sheets("Summary")
        .Columns("D:D").AutoFilter
        .Columns("D:D").AutoFilter Field:=1, Criteria1:="="
        .Rows("2:" & .Rows.Count).Delete Shift:=xlUp
        .Columns("D:D").AutoFilter Field:=1
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[vlbridge]

Great! Ok.. I think I almost have all the kinks worked out. There were some hidden rows that have formulas feeding a chart on another sheet. These are kind of messing with the results, but I'm slowly getting there. Thanks for all your help!

 

[SkipVought]

Sub DeleteHiddenRows()
    Dim lRow As Long
    
    With Sheets("Summary")
        For lRow = Intersect(.Columns(1), .UsedRange).Rows.Count To 1 Step -1
            With .Cells(lRow, "A").EntireRow
                If .Hidden Then .Delete
            End With
        Next
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}