Find cells with today's date and copy asscoiated columns

M

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
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
 
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
 
Please can you send me a excel, PLEASE
 
Ken Puls said:
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
Click to expand...

ok. I found it. THANKS
 
You must log in or register to reply here.
Back
Top