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