Overzetten data van tabblad

[DnA51535]

Hallo allen,
Ik zou graag gegevens van het ene tabblad naar het andere overzetten.
Ik dacht hier aan een macro of dergelijke maar ik ben leek daarin.
De sheet bevat 13 tabbladen, > van tabblad " resultaten" en van "resultaten (2)" > naar JAP 2020, "resultaten" heeft op zich de mogelijkheid om 5 jaar ver te gaan, zodat de resultaten van het jaar naar een ander JAP moet. resultaten 2020 naar JAP 2021, resultaten 2021 naar JAP 2022,
Hopelijk begrijpen jullie wat ik bedoel.

DnA

 

[knoet]

geen numerieke volgorde moet boven 21,5 staan

Deze opmerking begrijp ik niet, je hebt toch een neen staan bij

21.6	werden de verantwoordelijkheden bepaald?

 

[knoet]

Volgende versie.

 

[DnA51535]

Hey knoet,
dank, betreffende uw opmerking, ik denk dat u dit verkeerd gelezen hebt, ik had wel 21.1 aangeduid en niet 21.6, nu staat het numeriek, vooraleer ik "OK" zeg, zal ik nog enkele testen uitvoeren, > alles loopt goed, efkens wat bijgevuld onderaan de onderwerpen en getest.
Nu, hoe zet ik deze macro over? Ja, sorry eens leek, altijd leek!?
DnA

 

[knoet]

Je hebt wel degelijk 21.6 aangeduid, zie je voorbeeld in Post #30.
Om de code over te zetten, onderaan op het tabblad JAP2020 rechtsklikken -> Programacode weergeven klikken, daar de code kopiëren,daarna hetzelfde doen met je echte blad en daar de code plakken.
De knop kan je ook kopiëren en plakken.

 

[DnA51535]

knoet, Knop kopiëren en plakken > likt niet, rechtsklikken geeft geen resultaat, misschien een beetje uitleg

 

[knoet]

Je moet in de tab Ontwikkelaars eerst op Ontwerpmodus klikken.

 

[DnA51535]

Ok kopie, maar voert de macro niet uit

 

[knoet]

In ontwerpmodus, rechterklik op de k,op in het echte voorbeeld -> eigenschappen, in de eerste lijn (Name) CommandButton1 veranderen in Cmd1, terug op ontwerpmodus klikken om ontwerpmodus uit te schakelen.

 

[DnA51535]

Ok is gelukt, natuurlijk heb ik de kleur van de "voorwaardelijke opmaak" in de resultaten ook in het JAP 2020, en ook, doordat er een automatische nummering toegevoegd is heb ik volgende in de A kolom > =ALS(#VERW!="";""&#VERW!;LINKS(#VERW!; VIND.ALLES(" ";#VERW!)-1) & "."&AANTAL.ALS(#VERW!;#VERW!)), vb, 10 vragen in onderwerp "1 machines" geven 10 genummerde lijnen > 1.1, 1.2, 1.3, tot 1.10,
Kunnen wij alleen de waarden opnemen?

 

[knoet]

Test deze code eens.

Private Sub Cmd1_Click()

Application.ScreenUpdating = False

Set j20 = Sheets("JAP 2020")
lrJ20 = j20.Cells(Rows.Count, 1).End(xlUp).Row
If lrJ20 < 5 Then lrJ20 = 5
j20.Rows(5 & ":" & lrJ20).ClearContents
    
Set R = Sheets("Resultaten")
GoSub kopieer
    
Set R = Sheets("Resultaten (2)")
GoSub kopieer

For rij = lrJ20 To 5 Step -1
    If j20.Cells(rij, 2) = "" And j20.Cells(rij - 1, 2) = "" Then
        j20.Rows(rij - 1).Delete
    End If
Next rij

Exit Sub

kopieer:
With R
    lrR1 = .Cells(Rows.Count, 4).End(xlUp).Row
    For i = 8 To lrR1
        If .Cells(i, 4) <> "" Then
            lrJ20 = j20.Cells(Rows.Count, 1).End(xlUp).Row + 1
            If .Cells(i, 5) = "" Then
                j20.Cells(lrJ20, "A") = .Cells(i, "D")
                If InStr(1, .Cells(i, 4), ".") = 0 And .Cells(i, 7) = "" And IsNumeric(Left(.Cells(i, 4), 1)) Then
                    .Range("D" & i).Copy j20.Range("A" & lrJ20)
                End If
            Else
                If UCase(.Range("G" & i)) = "X" Then
                  .Range("D" & i & ":E" & i).Copy j20.Range("A" & lrJ20 & ":B" & lrJ20)
                End If
            End If
        End If
    Next i
End With
Return

End Sub

 

[DnA51535]

knoet, goede middag, niets veranderd, dat de voorwaardelijke opmaak uit de resultaten ook in het JAP 2020 te zien is > geen probleem dat maakt het een beetje overzichtelijker,
dat heb ik nu


Wat zien wij, #VERW! met witte regel is het onderwerp #VERW! met het knelpunt zou het knelpuntnummer moeten zijn,
Verder zien wij 21.4 staan in witte regel zou moeten zijn: 21 Beleidsverklaring > onderaan een "x" ??
DnA

 

[knoet]

Post de formule die in de A kolom staat en blijf werken met hetzelfde bestand, plots is mama en papa ook komen aankakken, sorry, ik heb geen glazen bol.

 

[DnA51535]

dat mama en papa komen aankakken is doordat ik een testje gedaan heb om te zien dat de nieuwe gegevens uit "resultaten" weggeschreven worden, dus dat is OK, maar niet 21.4 & x.
formule > =ALS(B9="";""&C9;LINKS(B9; VIND.ALLES(" ";B9)-1) & "."&AANTAL.ALS($B$8:B9;B9))

 

[knoet]

Private Sub Cmd1_Click()

Application.ScreenUpdating = False

Set j20 = Sheets("JAP 2020")
lrJ20 = j20.Cells(Rows.Count, 1).End(xlUp).Row
If lrJ20 < 5 Then lrJ20 = 5
j20.Rows(5 & ":" & lrJ20).ClearContents
    
Set R = Sheets("Resultaten")
GoSub kopieer
    
Set R = Sheets("Resultaten (2)")
GoSub kopieer

For rij = lrJ20 To 5 Step -1
    If j20.Cells(rij, 2) = "" And j20.Cells(rij - 1, 2) = "" Then
        j20.Rows(rij - 1).Delete
    End If
Next rij

Exit Sub

kopieer:
With R
    lrR1 = .Cells(Rows.Count, 4).End(xlUp).Row
    For i = 8 To lrR1
        If .Cells(i, 4) <> "" Then
            lrJ20 = j20.Cells(Rows.Count, 1).End(xlUp).Row + 1
            j20.Cells(lrJ20, "A") = .Cells(i, "D")
            If .Cells(i, 5) = "" Then
                If InStr(1, .Cells(i, 4), ".") = 0 And .Cells(i, 7) = "" And IsNumeric(Left(.Cells(i, 4), 1)) Then
                    .Range("D" & i).Copy j20.Range("A" & lrJ20)
                End If
            Else
                If UCase(.Range("G" & i)) = "X" Then
                  .Range("D" & i & ":E" & i).Copy j20.Range("A" & lrJ20 & ":B" & lrJ20)
                End If
            End If
        End If
    Next i
End With
Return

End Sub

 

[DnA51535]

Knoet, goede middag
dat heb ik nu, en start op A3 ipv A5, verder getest daarom wat meer lijnen, indien u dit niet wenst laat het weten