vba code to copy certain columns from multiple sheets into summary sheet and remove duplicates

[lisatylr70]

Hello. I am fairly new to VBA. I have a workbook with over 50 active sheets, each sheet could have different number of rows. I need to create a Macro to search through the majority of the sheets (some sheets are excluded) and if column T is >90 then copy columns A and T into a Summary sheet.
I need the macro to clear the contents of the summary sheet before pasting, and remove duplicates of column A in the summary sheet after pasting. I have researched several forums and come up with the below code, but this code copies the entire row and I can't quite figure out how to clear the contents of the summary sheet and remove the duplicates. I am using Excel 2016. Any help with this would be greatly appreciated.

Sub CopyOverstock()
Dim wsSum As Worksheet: Set wsSum = Sheets("OverStock Summary")
Dim ws As Worksheet
Dim rCell As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

For Each ws In Worksheets
If ws.Name <> wsSum.Name And ws.Name <> "OH Inv" And ws.Name <> "Usage SS" And ws.Name <> "Open POs" And ws.Name <> "Sheet1" And ws.Name <> "Potential GAPs" And ws.Name <> "Transfers" Then
For Each rCell In ws.Range("t4:t" & ws.Range("t" & Rows.count).End(xlUp).Row)
If rCell.Value <> "" And IsNumeric(rCell.Value) Then
If rCell.Value > 20 Then
rCell.EntireRow.Copy
wsSum.Cells(Rows.count, 1).End(xlUp)(2).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Next rCell
End If
Next ws

Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[NoSparks]

To clear the summary sheet

wsSum.Cells.ClearContents

To remove the duplicates based on column A

wsSum.UsedRange.RemoveDuplicates Columns:=1, Header:=xlNo

I'm not really sure what you're after with regards to saying it's copying entire rows,
that's what your macro says to do at this point

rCell.EntireRow.Copy

Where are you wanting columns A and T to end up?

My approach to things would be a little different.
You could speed things up by filtering rather than looping on the source sheets.
This may, or may not, be worth a look...

Sub CopyOverstock()

    Dim ws As Worksheet
    Dim wsSum As Worksheet
    Dim filtRng As Range

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set wsSum = Sheets("OverStock Summary")
'clear the summary sheet
wsSum.Cells.ClearContents

For Each ws In Worksheets
    'if the sheet isn't one of these
    If ws.Name <> wsSum.Name And ws.Name <> "OH Inv" And ws.Name <> "Usage SS" And ws.Name <> "Open POs" _
              And ws.Name <> "Sheet1" And ws.Name <> "Potential GAPs" And ws.Name <> "Transfers" Then
        'deal with the worksheet
        With ws
            'remove any existing filters
            If .AutoFilterMode Then .AutoFilterMode = False
            Set filtRng = .UsedRange
            filtRng.AutoFilter field:=20, Criteria1:=">90"
            .UsedRange.Offset(3).Copy
            wsSum.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            .AutoFilterMode = False
        End With
    End If
Next ws

'stop the marching ants
Application.CutCopyMode = False

With wsSum
    .Select
    .UsedRange.RemoveDuplicates Columns:=1, Header:=xlNo
    'remove unwanted columns
    .Columns("B:S").Delete
    'position the cursor
    .Cells(1).Select
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[lisatylr70]

Thank you so much for your help with this. I apologize for not specifying clearly in my original post. I realize in the code I posted stated to copy the entire row, but I couldn't figure out how to change that to be columns A and T only. I need to only copy the contents in columns A and T where the value in T is greater than 90 days and paste them in columns A and B of the summary sheet. Again, I appreciate your help.