Avatar billede HHA Professor
20. marts 2021 - 16:57 Der er 3 kommentarer og
1 løsning

Indsætte række i flere ark, med bestemt data/formel i cellerne

Jeg markerer en vilkårlig celle i ark1 og kører min VBA med indsæt række.
Den indsætter så en række i ark1, 2 og 3, men i ark2 og 3, skal den indsætte nogle formler i de første 4 kolonner.
Har dette stående i fx kolonne B, række 16 i ark2 og 3:
=HVIS('ark1'!B16="";"";'ark1'!B16)
Når jeg indsætter en ny linje i ark1 (automatisk i ark2 og 3) skal den indsætte ovenstående formel, dog med hensyn til hvilken række der er indsat.
Så tallet 16, skal skifte ift. hvilken række det er på.

Håber det gav mening.

Jeg har denne VBA til at indsætte linjerne:

Sub Indsæt_række()
'
' Indsæt_række Makro
' Indsætter række på flere ark
'
Dim ws As Worksheet
   
    ActiveWorkbook.Unprotect
    For Each ws In Worksheets
        ws.Unprotect
    Next
   
If Selection.Rows.Count = 1 Then
r = Selection.Row
Selection.EntireRow.Insert

Worksheets("ark2").Rows(r).EntireRow.Insert

Worksheets("ark3").Rows(r).EntireRow.Insert

Else
MsgBox ("Vælg kun en linje ad gangen før indsætning")
End If
   
    ActiveWorkbook.Protect
    For Each ws In Worksheets
        ws.Protect
    Next
   
End Sub
Avatar billede jens48 Ekspert
20. marts 2021 - 18:13 #1
Hvis du kun indsætter linjer efter linje 16 kan dette måske bruges:

Sub Indsæt_række()
Dim ws As Worksheet
'
' Indsæt_række Makro
' Indsætter række på flere ark
'
Dim ws As Worksheet
 
    ActiveWorkbook.Unprotect
    For Each ws In Worksheets
        ws.Unprotect
    Next
If Selection.Rows.Count = 1 Then
r = Selection.Row
Selection.EntireRow.Insert
Worksheets("ark2").Rows(r).EntireRow.Insert
Worksheets("ark2").Range("B16").Copy
Worksheets("ark2").Cells(r, 2).PasteSpecial xlPasteFormulas
Worksheets("ark3").Rows(r).EntireRow.Insert
Worksheets("ark3").Range("B16").Copy
Worksheets("ark3").Cells(r, 2).PasteSpecial xlPasteFormulas
Else
MsgBox ("Vælg kun en linje ad gangen før indsætning")
End If
  ActiveWorkbook.Protect
    For Each ws In Worksheets
        ws.Protect
    Next
End Sub
Avatar billede HHA Professor
20. marts 2021 - 18:52 #2
Er på vej i den rigtige retning.
Kan der bygges en sikkerhed ind, der gør at den kun godkender at det er markeringen i ark1 der gælder?
Den kan lave noget volapyk i ark 2 og 3 og undlade at indsætte linje i ark1.
Fx indsætte en linje i ark2 og 2 linjer i ark3, hvor de 2 linjer er ens, med reference til den samme linje i ark1.
Tror det er noget med at den kigger efter hvad ark der er låst sidst (er et rent gæt på hvad det er der laver problemet)?

Sub Indsæt_række()
'
' Indsæt_række Makro
' Indsætter række på flere ark
 
    Sheets("ark1").Unprotect
    Sheets("ark2").Unprotect
    Sheets("ark3").Unprotect
   
If Selection.Rows.Count = 1 Then
r = Selection.Row
Selection.EntireRow.Insert
Worksheets("ark2").Rows(r).EntireRow.Insert
Worksheets("ark2").Range("A4:D4").Copy
Worksheets("ark2").Cells(r, 2).PasteSpecial xlPasteFormulas

Worksheets("ark3").Rows(r).EntireRow.Insert
Worksheets("ark3").Range("A4:D4").Copy
Worksheets("ark3").Cells(r, 2).PasteSpecial xlPasteFormulas

Else
MsgBox ("Marker kun en linje ad gangen før indsætning")
End If
 
    Sheets("ark1").Protect
    Sheets("ark2").Protect
    Sheets("ark3").Protect
   
End Sub
Avatar billede jens48 Ekspert
22. marts 2021 - 08:49 #3
Da jeg ikke ved hvad der laves af volapyk på ark2 og ark 3 kan det kun blive et gæt. Men prøv denne:

Sub Indsæt_række()
'
' Indsæt_række Makro
' Indsætter række på flere ark

    Sheets("ark1").Unprotect
    Sheets("ark2").Unprotect
    Sheets("ark3").Unprotect
 
r = Selection.Row
If Selection.Rows.Count = 1 And r > 4 And ActiveSheet.Name = "Ark1" Then
Selection.EntireRow.Insert
Worksheets("ark2").Rows(r).EntireRow.Insert
Worksheets("ark2").Range("A4:D4").Copy
Worksheets("ark2").Cells(r, 2).PasteSpecial xlPasteFormulas

Worksheets("ark3").Rows(r).EntireRow.Insert
Worksheets("ark3").Range("A4:D4").Copy
Worksheets("ark3").Cells(r, 2).PasteSpecial xlPasteFormulas

Else
MsgBox ("Marker kun en linje ad gangen før indsætning")
End If

    Sheets("ark1").Protect
    Sheets("ark2").Protect
    Sheets("ark3").Protect
 
End Sub
Avatar billede HHA Professor
22. juni 2021 - 19:59 #4
Dette blev løst via hjælp fra jens48 over mail.

Tak til jens48 for hjælpen.
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester