Avatar billede HHA Professor
17. maj 2021 - 18:59

VBA overføre markeret celle (række)

Hejsa,

Har nedenstående VBA der kigger efter om der står JA eller NEJ i kolonne A.
Men kunne godt tænke mig at den kunne overføre den række som jeg har markeret en celle i.
Den skal kigge efter hvilken række jeg har markeret en celle i og overføre den, når jeg klikker på knappen der kører overfør.
Men den skal ikke overføre den markerede linje, hvis der står JA i en celle i kolonne A.

Håber det gav mening.


    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim LR1 As Long, LR2 As Long, LR3 As Long, LR4 As Long, i As Long
   
       
   
    Set ws1 = Sheets("Kalk")
    Set ws2 = Sheets("Standardpriser")
   
    LR3 = ws2.Range("N" & Rows.Count).End(xlUp).Row
   
    LR4 = WorksheetFunction.Sum(Range("N18:N" & LR3))
   
           
    If LR4 < 1 Then
        MsgBox "Du skal vælge en linje at overføre"
        Sheets("Standardpriser").Select
        Exit Sub
    End If
   
   
    Sheets("Kalk").Select ' vælger celle på kalk ark
    Range("D" & (ActiveCell.Row)).Select
   
   
    LR2 = ActiveCell.Row
    LR1 = ws2.Range("C" & Rows.Count).End(xlUp).Row
   
    If LR2 < 20 Then 'Sikrer at der ikke bliver overført data til en ulovlig række på kalk ark
        MsgBox "Fejl: Du prøver at indsætte værdier i en ulovlig række. Marker en lovlig række hvor du ønsker at indsætte standardprisen"
        Sheets("Kalk").Select
        Exit Sub
    End If
   
   
    ws1.Unprotect
    ws2.Unprotect
   
   
    Application.ScreenUpdating = False
   
       
     
    For i = 20 To LR1
       
        If ws2.Range("A" & i).Value = "Ja" Then
                   
         
           
           
            ws1.Cells((ActiveCell.Row), "D").Value = ws2.Cells(i, "C").Value
            ws1.Cells((ActiveCell.Row), "E").Value = ws2.Cells(i, "D").Value
            ws1.Cells((ActiveCell.Row), "F").Value = ws2.Cells(i, "E").Value * ws2.Cells(i, "B")
            ws1.Cells((ActiveCell.Row), "I").Value = ws2.Cells(i, "F").Value * ws2.Cells(i, "B")
            ws1.Cells((ActiveCell.Row), "J").Value = ws2.Cells(i, "G").Value * ws2.Cells(i, "B")
            ws1.Cells((ActiveCell.Row), "K").Value = ws2.Cells(i, "H").Value * ws2.Cells(i, "B")
            ws1.Cells((ActiveCell.Row), "L").Value = ws2.Cells(i, "I").Value * ws2.Cells(i, "B")
            ws1.Cells((ActiveCell.Row), "M").Value = ws2.Cells(i, "L").Value
            If ws2.Range("B" & i).Value > 1 Then ws1.Cells((ActiveCell.Row), "M").Value = "NEJ" ' Ændrer enhedspris til NEJ, hvis Celle B er større end 1
                                   
            ws2.Cells(i, "B").Value = 1
            Call Makro_indsæt_række
            ActiveCell.Offset(1).Select
        End If
       
           
    Next i
   
   
       
    ' GENLÅSNING AF ARK
   
    Application.ScreenUpdating = True
 
   
 
   
    Worksheets("Standardpriser").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    EnableSelection = xlNoRestrictions
   
    Worksheets("Kalk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
   
End Sub
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