Cellen niet overschrijven na gebruik van een macro

[Dac1968]

Hoe kan ik voorkomen nadat ik een macro heb gebruikt dat bij de volgende keer niet de zelfde kolom weer wordt overschreven maar dat hij automatisch naar de volgende kolom gaat.

Range("B3:B61").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-45
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("D2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("E4").Select

 

[HSV]

Doe er eens een bestandje bij met een duidelijke beschrijving i.p.v. een stukje opgenomen code zonder codetags.

 

[Dac1968]

Sorry,Bekijk bijlage test.xlsm

De volgende keer als ik dus de macro draai zou ik graag een kolom verder de data willen zien.

 

[Warme bakkertje]

Sub Macro7()
    If Range("D3") = "" Then
        With Range("D3")
            .Resize(59).Value = Range("B3").Resize(59).Value
            .Offset(-1) = Date
        End With
    Else
        With Range("IV3").End(xlToLeft)
            .Offset(, 1).Resize(59).Value = Range("B3").Resize(59).Value
            .Offset(-1, 1) = Date
        End With
    End If
End Sub

 

[Roncancio]

Sub Kopiëren()
Dim lCol  As Long
    lCol = Cells(2, Columns.Count).End(xlToLeft).Column + 1
    Cells(1, lCol).EntireColumn.Value = Range("B:B").Value
    Cells(2, lCol).Value = Date
End Sub

Met vriendelijke groet,


Roncancio

 

[Dac1968]

Bedankt voor jullie snelle oplossingen