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

zillmatic

New Member
Joined
Nov 5, 2019
Messages
2
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:

Code:
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!
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,630
Office Version
365
Platform
Windows
How about
Code:
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,630
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,102,305
Messages
5,486,072
Members
407,531
Latest member
WalterR01

This Week's Hot Topics

Top