Create Macros to copy a column with today's date.

[SempraLaura]

Basically I have a date =Today() written on A1
- I would like it to locate the value in A1 and find it on the sheet, in this case on cell B9
- Copy the entire column, in this case B9:B40
- Paste everything on the next column over, in this case C9:C40
- Then PasteValues on the original column so the formulas remain only on the most recent column.

Kindly see attachment.




Thank you,

-L

 

[Asheesh]

Welcome on board...

Do you want this operation to take place on a particular sheet or all the sheets that are available in the workbook...I ask this..becuase I see 2 tabs with similar table formats...

Edit:

So do we have to search for todays date always in Row no 9....if no, then where else can this date be available

 

[SempraLaura]

Welcome on board...

Do you want this operation to take place on a particular sheet or all the sheets that are available in the workbook...I ask this..becuase I see 2 tabs with similar table formats...

Edit:

So do we have to search for todays date always in Row no 9....if no, then where else can this date be available

Hi,

So it would be on multiple sheets. In this case let's just say both "Sheet 1" & "Sheet 2". Yes, the date will always be on row 9. Thank you!

 

[Nebu]

Hi:

Use the following code

Sub ColCopy()
Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim i As Long
Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Range("A1") = ws.Range("B9") Then
        i = ws.Cells(Rows.Count, "B").End(xlUp).Row
        ws.Range("B9:B" & i).Copy
        ws.Range("C9").PasteSpecial xlPasteFormulasAndNumberFormats
        ws.Range("B9").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Thanks

 

[Asheesh]

Since I worked on it...so posting it here..

Sub test()

Dim tDate As String
Dim iCol As Integer
Dim sh As Integer


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'Change the sheet reference according to your need**this should be the sheet name which stores the date in cell A1
tDate = Sheets("Sheet1").Range("A1").Value

For sh = 1 To Sheets.Count

Sheets(sh).Activate

Rows("9:9").Select

iCol = Selection.Find(What:=tDate, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Column
        
Range(Cells(10, iCol), Cells(Rows.Count, iCol).End(xlUp)).Copy

Cells(10, iCol + 1).PasteSpecial Paste:=xlPasteFormulas

Cells(10, iCol).PasteSpecial Paste:=xlPasteValues

Next sh

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

End Sub

Attached is the spreadsheet for your reference.