Paste formula into next free column

2019-08-17 07:54发布

Following issue: I want to update a report and its formulas based on a date cell (located in first row). Loop should go until yesterday's date. This is how the sheet looks like:

enter image description here

How do add the date dynamically is achieved, now I want to update the corresponding formulas below (row 2 - 35) up until the newest date entry. This is what code I have written so far:

Sub Update_Newest_Day_Conversions()

Worksheets("CPC - Conversions DoD").Range("A1"). _
End(xlToRight).Select

MyDate = Date - 1

While ActiveCell.Value < MyDate

ActiveCell.Copy ActiveCell.Offset(0, 1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Value + 1
ActiveCell.Offset(1, -1).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
ActiveRange.Copy Offset(0, 1)

Wend

End Sub

The formula stops working when I try to copy the active selected range and I receive the following error message:

Compile Error: sub or function not defined.

It points out to the Offset(0,1) method. Any idea what I'm doing wrong? I know I'm pretty close.

2条回答
Evening l夕情丶
2楼-- · 2019-08-17 08:16

found a solution in case anybody's interested:

Sub Update_Newest_Day_Conversions()

Worksheets("CPC - Conversions DoD").Range("A1"). _
End(xlToRight).Select


MyDate = Date - 1

While ActiveCell.Value < MyDate

ActiveCell.Copy ActiveCell.Offset(0, 1)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Value + 1
ActiveCell.Offset(1, -1).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy ActiveCell.Offset(0, 1)
ActiveCell.Offset(-1, 1).Select

Wend

End Sub
查看更多
男人必须洒脱
3楼-- · 2019-08-17 08:18

Please try this code. I have amended it to accommodate the more precise description of your requirements.

Sub Update_Newest_Day_Conversions()
    ' 19 Feb 2018

    Dim MyDate As Date
    Dim LastDate As Date
    Dim Rng As Range
    Dim Rl As Long                              ' last row
    Dim C As Long                               ' column counter

    MyDate = Date - 1
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    With Worksheets("CPC - Conversions DoD")
        C = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Rl = .Cells(.Rows.Count, C).End(xlUp).Row
        LastDate = .Cells(1, C).Value
        Do While LastDate < MyDate
            Set Rng = Range(.Cells(2, C), .Cells(Rl, C))
            Rng.Copy Rng.Offset(0, 1)
            LastDate = LastDate + 1
            C = C + 1
            .Cells(1, C).Value = LastDate
            .Columns(C).AutoFit
        Loop
    End With
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
查看更多
登录 后发表回答