Avatar billede HHA Professor
03. november 2021 - 19:14 Der er 8 kommentarer og
1 løsning

Overførsel fra et ark til et andet

Hejsa,

Troede jeg var færdig mede denne :)

Men nedenestående kode overfører de linjer, hvor der står "nej" i kolonne B, som tomme linjer på det ark de overføres til.
Men den skal springe linjerne over, hvor der står nej.

Nogen som kan se hvorfor den laver det?

Her et klip af starten af koden, som burde indeholde det der fejler.
Og ja, det er en jeg tidligere havde troet var ok, men det er den desværre ikke.
Jeg havde ikke testet nok 😒

Sub Oveførtiltilbud2()
   
    Dim 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")
    Set ws3 = Sheets("Tilbud Engelsk")
    Worksheets("Tilbud dansk").Unprotect
    Worksheets("Tilbud engelsk").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 = 20 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"   
                                                     
        ElseIf ws1.Range("B" & i).Value = ("TEKST") Then '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 = 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 = 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"
   
           
           
        End If
       
      LR2 = LR2 + 1
               
    Next i
Avatar billede ebea Ekspert
03. november 2021 - 21:47 #1
Du har jo ikke angivet, hvad der skal ske, hvis der står "NEJ" i linjerne i ws1. Du har kun "JA" og "TEKST"
Avatar billede store-morten Ekspert
03. november 2021 - 23:04 #2
Prøv at bytte om på:

End If
       
      LR2 = LR2 + 1
Avatar billede HHA Professor
04. november 2021 - 06:08 #3
ebea, det har du nok ret i.

Men hvad kunne koden for nej så være?

ElseIf ws1.Range("B" & i).Value = ("Nej") Then next et eller andet ?

Tidligere hvor der kun var ja og nej, havde jeg kun den kode med ja og så sprang den automatisk nej linjerne over. Uden at lave tomme linjer.
Avatar billede HHA Professor
04. november 2021 - 06:10 #4
store-morten,

Så laver den kludder i det, det testede vi også sidste gang.
Den over fører så kun et par af de linjer med tekst og intet andet.
Så mangler den vel 200 linjer at overføre.
Avatar billede store-morten Ekspert
04. november 2021 - 07:17 #5
Måske:

Else
LR2 = LR2 - 1

        End If
     
      LR2 = LR2 + 1
             
    Next i
Avatar billede HHA Professor
04. november 2021 - 08:45 #6
store-morten,

Har ikke testet dit seneste forslag, da jeg ikke helt ved hvor jeg skal sætte det ind.
Er det i enden af: ElseIf ws1.Range("B" & i).Value = ("Nej") Then LR2 = LR2 - 1 ?

Jeg mente ellers at det virkede sidst da I hjalp mig og var sgu lidt forvirret da det ikke virkede i går.
Her til morgen tog jeg et andet ark og testede den VBA der ikke virkede i går.
Den virkede fint. Så opdagede jeg at der var byttet rundt på Tekst og Ja koderne.

Ved ikke hvorfor det virker men ikke når det er omvendt 🤷‍♂️

LR2 = 105
   
    For i = 20 To LR1
     
       
        If 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 = 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 = 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
             
        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 = 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
       
                   
    Next i
Avatar billede HHA Professor
04. november 2021 - 08:48 #7
Der er dog en bug, den begynder efter at have overført næsten en hel side at lave teksten til Ariel i stedet for Calibri, som der står i formlen.

Nogen bud på hvad det er der laver det?
Mindes på et tidspunkt at der var en der nævnte noget med Excel og Ariel, at der var en bug.
Avatar billede store-morten Ekspert
04. november 2021 - 09:05 #8
Nej, jeg tænker hvis du tilføjer:

Else
LR2 = LR2 - 1

Sidst i koden, som #5

Så der trækkes 1 række fra hvis de to kriterier ikke op fyldes, således at der ikke sættes tomme rækker ind.
Avatar billede HHA Professor
04. november 2021 - 09:47 #9
store-morten,

Ja, selvfølgelig!
Takker 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