24. februar 2019 - 20:32Der er
6 kommentarer og 2 løsninger
VBA kode
Hej Eksperter
Jeg har brug for jeres hjælp.!
tænkte at lave en macro i VBA
har et beskyttet regneark som indeholder noget tidsregistrering. Jeg vil gerne tilføje nogle rækker i forlængelse af regnearket samt kopiere formlerne med.
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
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>
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;" ")
Sub NyRaekke() With ActiveSheet .Unprotect Password:="" Range(.Range("B" & Rows.Count).End(xlUp), .Range("B" & Rows.Count).End(xlUp).Offset(0, 24)).Copy Destination:=.Range("B" & Rows.Count).End(xlUp).Offset(1, 0) .Protect Password:="" End With End Sub
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]
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.