Copy certain cells in a row to another tab if value in column >= date()

[zillmatic]

I found a thread that was extremely helpful in copying entire rows when the value in a specified column > 0. However, I only want the values in columns A,B,C,D,G,S instead of the entire row.

The code I modified from Fluff's answer looks like:

Sub WeeklyReport()

Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Current")
Set ws2 = Sheets("ReportOut")


lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range("G1:G" & lr)


For Each cell In rng
    If cell.Value >= Date() Then
        cell.EntireRow.Copy
        If ws2.Range("A1").Value = "" Then
            ws2.Range("A1").PasteSpecial xlPasteValues
        Else
            ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End If
    End If
Next cell


Application.CutCopyMode = False
Range("A1").Select

End Sub

How would I do it if I only want certain columns instead of the entire row? I'd want the values in columns A,B,C,D,G,S from the first tab to paste in columns A,B,C,D,E,F in the second.

Alternatively I could copy the entire row, then at the end have it delete the columns I don't need. This may be a ton easier, but I'd also need to keep the formatting from the first tab in this case.

Thanks!

 

[Fluff]

How about

Sub WeeklyReport()

Dim rng As Range
Dim cell As Range
Dim lr As Long
[COLOR=#ff0000]Dim Ary As Variant[/COLOR]
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Current")
Set ws2 = Sheets("ReportOut")


lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range("G1:G" & lr)


For Each cell In rng
    If cell.Value >= Date Then
        [COLOR=#ff0000]Ary = Application.Index(cell.EntireRow, 1, Array(1, 2, 3, 4, 7, 19))[/COLOR]
        If ws2.Range("A1").Value = "" Then
            ws2.Range("A1").[COLOR=#ff0000]Resize(, 6).Value = Ary[/COLOR]
        Else
            ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).[COLOR=#ff0000]Resize(, 6).Value = Ary[/COLOR]
        End If
    End If
Next cell


Application.CutCopyMode = False
Range("A1").Select

End Sub

 

[zillmatic]

You make it look so easy. This is perfect. Thanks hero!

 

[Fluff]

You're welcome & thanks for the feedback