Problem med VBA kode
Hejsa,Jeg har et problem med nedenstående kode.
Den overfører fint som den skal, men så snart den møder et felt med "TEKST" så går det galt med overførslen.
For mig ligner det at den ikke kommer op øverst i koden igen og kigger efter celler med "JA".
Den kludrer noget i det.
Koden skal overføre tekst fra celle D, hvis der er et JA eller TEKST i celle B.
Værdi fra enten celle Q eller R alt efter om der er et JA eller NEJ i celle M og ingen værdi overhovedet, hvis der står TEKST i celle B.
Er der nogen der kan se hvad der er galt med koden?
8Dim ws1 As Worksheet, ws2 As Worksheet, ws3 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("Kalk")
Set ws2 = Sheets("Tilbud dansk")
Worksheets("Tilbud dansk").Unprotect
ws2.Range("A105:A" & Rows.Count).ClearContents
ws2.Range("B105:B" & Rows.Count).ClearContents
ws2.Range("C105:C" & Rows.Count).ClearContents
ws2.Range("D105:D" & Rows.Count).ClearContents
ws2.Cells.Borders.LineStyle = xlLineStyleNone
LR1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
ActiveSheet.Unprotect
Application.ScreenUpdating = False
LR2 = 105
For i = 10 To LR1
If 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 = 12
ws2.Cells(LR2, "A").Font.FontStyle = "Calibri"
ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
ws2.Cells(LR2, "B").BorderAround xlContinuous
ws2.Cells(LR2, "B").Font.Size = 12
ws2.Cells(LR2, "B").Font.FontStyle = "Calibri"
ws2.Cells(LR2, "C").Value = ws1.Cells(i, "R").Value
ws2.Cells(LR2, "C").BorderAround xlContinuous
ws2.Cells(LR2, "C").Font.Size = 12
ws2.Cells(LR2, "C").Font.FontStyle = "Calibri"
ws2.Cells(LR2, "D").Value = ws1.Cells(i, "Q").Value
ws2.Cells(LR2, "D").BorderAround xlContinuous
ws2.Cells(LR2, "D").Font.Size = 12
ws2.Cells(LR2, "D").Font.FontStyle = "Calibri"
LR2 = LR2 + 1
'End If
ElseIf ws1.Range("B" & i).Value = ("TEKST") And ws1.Range("M" & 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 = 12
ws2.Cells(LR2, "A").Font.FontStyle = "Calibri"
ws2.Cells(LR2, "B").Value = ws1.Cells(i, "D").Value
ws2.Cells(LR2, "B").BorderAround xlContinuous
ws2.Cells(LR2, "B").Font.Size = 12
ws2.Cells(LR2, "B").Font.FontStyle = "Calibri"
ws2.Cells(LR2, "C").Value = Clear 'ws1.Cells(i, "AA").Value
ws2.Cells(LR2, "C").BorderAround xlContinuous
ws2.Cells(LR2, "C").Font.Size = 12
ws2.Cells(LR2, "C").Font.FontStyle = "Calibri"
ws2.Cells(LR2, "D").Value = Clear 'ws1.Cells(i, "AA").Value
ws2.Cells(LR2, "D").BorderAround xlContinuous
ws2.Cells(LR2, "D").Font.Size = 12
ws2.Cells(LR2, "D").Font.FontStyle = "Calibri"
LR2 = LR2 + 1
End If
Next i
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
Worksheets("Tilbud dansk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
Worksheets("Kalk").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
End Sub