Find cells with today's date and copy asscoiated columns

manos

New member
Joined
Nov 12, 2012
Messages
13
Reaction score
0
Points
0
Hello,


I have a spreadsheet where various dates are in row
I require a vba code or macro that will do the following:
where the date in is today's date. Then copy the selection

This must be simple but for some reason i am just not getting it!


Would appreciate any help
 

Attachments

  • example.xls
    31 KB · Views: 22

Bob Phillips

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,942
Reaction score
0
Points
36
Excel Version(s)
O365
Code:
Sub CopyData()Dim lastcol As Long
Dim nextcol As Long
Dim i As Long


    With ActiveSheet
    
        lastcol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lastcol
        
            If .Cells(3, i).Value = Date Then
            
                nextcol = nextcol + 1
                .Range(.Cells(3, i), .Cells(3, i).End(xlDown)).Copy Worksheets("Sheet2").Cells(1, nextcol)
            End If
        Next i
    End With
End Sub
 

Ken Puls

Administrator
Staff member
Joined
Mar 13, 2011
Messages
2,524
Reaction score
6
Points
38
Location
Nanaimo, BC, Canada
Website
www.excelguru.ca
Excel Version(s)
Excel Office 365 Insider
Missed a hard return. Try this:

Code:
Sub CopyData()
Dim lastcol As Long
Dim nextcol As Long
Dim i As Long


    With ActiveSheet
    
        lastcol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lastcol
        
            If .Cells(3, i).Value = Date Then
            
                nextcol = nextcol + 1
                .Range(.Cells(3, i), .Cells(3, i).End(xlDown)).Copy Worksheets("Sheet2").Cells(1, nextcol)
            End If
        Next i
    End With
End Sub
 

manos

New member
Joined
Nov 12, 2012
Messages
13
Reaction score
0
Points
0
Please can you send me a excel, PLEASE
 

manos

New member
Joined
Nov 12, 2012
Messages
13
Reaction score
0
Points
0
Missed a hard return. Try this:

Code:
Sub CopyData()
Dim lastcol As Long
Dim nextcol As Long
Dim i As Long


    With ActiveSheet
    
        lastcol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        For i = 1 To lastcol
        
            If .Cells(3, i).Value = Date Then
            
                nextcol = nextcol + 1
                .Range(.Cells(3, i), .Cells(3, i).End(xlDown)).Copy Worksheets("Sheet2").Cells(1, nextcol)
            End If
        Next i
    End With
End Sub

ok. I found it. THANKS
 
Top