Avatar billede HHA Guru
09. februar 2021 - 21:08 Der er 4 kommentarer og
1 løsning

VBA koder overskriver hinanden

Hejsa,

Nedenstående kode, kan jeg ikke få til at køre rigtigt.
Den overfører data fra et ark til et andet, men den der "kører efter TEKST" bliver over skrevet af den der "kører efter JA"

Bytter jeg om på dem, så er det bare den anden der overskriver.
Jeg kan ikke se hvad der skal til for at den kun kører den del der skal ift. hvad der står i kolonne B.
Hvad er der galt med koden?

Sub OveførttilTEST2()
 
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim LR1 As Long, LR2 As Long, LR3 As Long, LR4 As Long, n As Long, i As Long, b As Long, Lastrow As Long
 
 
    Set ws1 = Sheets("TEST")
    Set ws2 = Sheets("TEST2")

    Worksheets("TEST2").Unprotect
    ws2.Range("A119:A" & Rows.Count).ClearContents
    ws2.Range("B119:B" & Rows.Count).ClearContents
    ws2.Range("C119:C" & Rows.Count).ClearContents
    ws2.Range("D119:D" & Rows.Count).ClearContents
    ws2.Cells.Borders.LineStyle = xlLineStyleNone
 
    LR1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
    ActiveSheet.Unprotect
 
    Application.ScreenUpdating = False
 
    LR2 = 119
 
    For i = 10 To LR1
 
    'Det er denne der overskrives af den ElseIF nedenfor
 
        If ws1.Range("B" & i).Value = "TEKST" Then
            ws2.Cells(LR2, "A").Value = ws1.Cells(i, "A").Value
            ws2.Cells(LR2, "A").BorderAround xlContinuous
            ws2.Cells(LR2, "A").Font.Size = 10
            ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
            ws2.Cells(LR2, "B").BorderAround xlContinuous
            ws2.Cells(LR2, "B").Font.Size = 10
            ws2.Cells(LR2, "C").Value = ws1.Cells(i, "AA").Value
            ws2.Cells(LR2, "C").BorderAround xlContinuous
            ws2.Cells(LR2, "C").Font.Size = 10
            ws2.Cells(LR2, "D").Value = ws1.Cells(i, "AA").Value
            ws2.Cells(LR2, "D").BorderAround xlContinuous
            ws2.Cells(LR2, "D").Font.Size = 10
         
         
    ElseIf ws1.Range("B" & i).Value = "JA" Then
            ws2.Cells(LR2, "A").Value = ws1.Cells(i, "A").Value
            ws2.Cells(LR2, "A").BorderAround xlContinuous
            ws2.Cells(LR2, "A").Font.Size = 10
            ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
            ws2.Cells(LR2, "B").BorderAround xlContinuous
            ws2.Cells(LR2, "B").Font.Size = 10
            ws2.Cells(LR2, "C").Value = ws1.Cells(i, "R").Value
            ws2.Cells(LR2, "C").BorderAround xlContinuous
            ws2.Cells(LR2, "C").Font.Size = 10
            ws2.Cells(LR2, "D").Value = ws1.Cells(i, "Q").Value
            ws2.Cells(LR2, "D").BorderAround xlContinuous
            ws2.Cells(LR2, "D").Font.Size = 10
         
        LR2 = LR2 + 1
     
        End If
         
    Next i
 
   
    Application.ScreenUpdating = True

 
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("TEST2").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
    Worksheets("TEST").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True

 
End Sub
Avatar billede Docthomassen Juniormester
09. februar 2021 - 21:58 #1
Hmm.
Umiddelbart har jeg svært ved at se hvordan en range kan være lig en specifik tekst.

For at finde ud af hvornår dine if og elseif fejler, så prøv feks at indføje msgbox:

If ws1.Range("B" & i).Value = "TEKST" Then
    Msgbox("Nu er TEKST aktiveret og i =  " & i)
    ...
    ...

ElseIf ws1.Range("B" & i).Value = "JA" Then
    Msgbox("Nu er JA aktiveret og i =  " & i)
    ...
    ...
Avatar billede store-morten Ekspert
09. februar 2021 - 22:39 #2
Ja, hvis der står: JA som det sidste under TEKST i kolonne B så over skriver den.
Avatar billede store-morten Ekspert
09. februar 2021 - 22:50 #3
Ser lige din tæller: LR2 = LR2 + 1

Prøv at flytte den ned under: End if
Avatar billede store-morten Ekspert
09. februar 2021 - 23:22 #4
Eller måske er det sådan du vil:
    For i = 10 To LR1

        If ws1.Range("B" & i).Value = "TEKST" Then
       
            'gør noget
           
        LR2 = LR2 + 1
        End If
       
        If ws1.Range("B" & i).Value = "JA" Then

            'gør noget
       
        LR2 = LR2 + 1
        End If
       
    Next i
Avatar billede HHA Guru
11. februar 2021 - 19:47 #5
Takker endnu en gang 👍
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
Kategori
Excel-kurser for alle niveauer og behov – find det kursus, der passer til dig

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





White paper
Tidsbegrænset kampagne: Overvejer du at udskifte eller tilføje printere i din forretning? Vi kan tilbyde én eller flere maskiner gratis