VBA kode

Her er lidt at lege videre med - god fornøjelse

Sub schoelser_954808()
    Dim ws As Worksheet, i As Integer, lNextRow As Long
    Const numberOfColumns = 7
   
    Set ws = ActiveSheet
    lNextRow = ws.Range("A1").End(xlDown).Row + 1
   
    With ws
        .Unprotect Password:=""
        For i = 1 To numberOfColumns 'checker sidste række for formler - en kolonne ad gangen
            If .Cells(lNextRow - 1, i).HasFormula Then
                .Cells(lNextRow, i).Formula = .Cells(lNextRow - 1, i).Formula 'kopierer formler
            End If
        Next i
        .Protect Password:=""
    End With
End Sub

Hej smartoffice_dk

Det er netop løsningen. dog mangler jeg at kunne få kanterne med i kopieringen.

Jan

Sub schoelser_954808()
    Dim ws As Worksheet, i As Integer, lNextRow As Long
    Const numberOfColumns = 7
   
    Set ws = ActiveSheet
    lNextRow = ws.Range("A1").End(xlDown).Row + 1
   
    With ws
        .Unprotect Password:=""
        For i = 1 To numberOfColumns 'checker sidste række for formler - en kolonne ad gangen
            If .Cells(lNextRow - 1, i).HasFormula Then
                .Cells(lNextRow, i).Formula = .Cells(lNextRow - 1, i).Formula 'kopierer formler
            End If
            .Cells(lNextRow - 1, i).Copy
            .Cells(lNextRow, i).PasteSpecial xlPasteFormats
        Next i
        .Protect Password:=""
    End With
End Sub

Alle de gange koden ovenover kommer til at kopiere kan godt gøre koden lidt sløv, specielt ved mange kolonner, så copy/past nummer skal kun gøres én gang, som her...

<DIV>
Sub schoelser_954808()
    Dim ws As Worksheet, i As Integer, lNextRow As Long
    Const numberOfColumns = 7
   
    Set ws = ActiveSheet
    lNextRow = ws.Range("A1").End(xlDown).Row + 1
   
    With ws
        .Unprotect Password:=""
        For i = 1 To numberOfColumns 'checker sidste række for formler - en kolonne ad gangen
            If .Cells(lNextRow - 1, i).HasFormula Then
                .Cells(lNextRow, i).Formula = .Cells(lNextRow - 1, i).Formula 'kopierer formler
            End If
        Next i
        .Range(.Cells(lNextRow - 1, 1), .Cells(lNextRow - 1, numberOfColumns)).Copy
        .Range(.Cells(lNextRow, 1), .Cells(lNextRow, numberOfColumns)).PasteSpecial xlPasteFormats
        .Protect Password:=""
    End With
End Sub
</DIV>

Glem <div></div>

Hej Flemming

Det virker med undtagelse af formlerne. feks er en formel =HVIS(E3>=0;D3;" ") og når den bliver kopieret er den stadig =HVIS(E3>=0;D3;" ") men burde være =HVIS(E4>=0;D4;" ")

Jan

Denne udgave sletter gamle værdier fra forrige linie

[div]Sub schoelser_954808()
    Dim ws As Worksheet, i As Integer, lNextRow As Long
    Const numberOfColumns = 7
   
    Set ws = ActiveSheet
    lNextRow = ws.Range("A1").End(xlDown).Row + 1
   
    With ws
        .Unprotect Password:=""
        .Range(.Cells(lNextRow - 1, 1), .Cells(lNextRow - 1, numberOfColumns)).Copy Destination:=.Range(.Cells(lNextRow, 1), .Cells(lNextRow, numberOfColumns))
        For i = 1 To numberOfColumns
            If Not .Cells(lNextRow - 1, i).HasFormula Then 'Ryd op
                .Cells(lNextRow, i).Value = ""
            End If
        Next i
        .Protect Password:=""
    End With
End Sub[<div]