Kopiëren gegevens

[Danielle22]

Hallo allemaal,

Ik heb een Excel bestand met daarin allemaal testgegevens. Ik heb in het hoofdblad een vaste indeling staan (gekeurde velden). Deze moeten eigenlijk aangevuld worden met de gegevens van het blad “testresultaten”. De unieke code is de “soort“ code.

Dus de soortcode die in kolom A staat moet aangevuld worden met de gegeven uit het tabblad “testresultaten”. Op dit moment voeg ik zelf alle rijen toe en kopieer ik de gegevens van het tabblad “testresultaten” handmatig in het schema.

Weet iemand of dit mogelijk is met een VBA code o.i.d of hoe ik het efficiënter in kan richten?

Ik heb ook even een voorbeeld gemaakt van het bestand.

Alvast heel erg bedankt voor de eventuele reacties.

Groetjes,

Daniëlle
Bekijk bijlage Voorbeeld kopie gegevens.xlsx

 

[robdgr]

Daniëlle,

Dit kan met formules en toevoeging van een kolom.

 

[Danielle22]

Hoi Rob,

Heel erg bedankt voor je reactie.

Het lastigste is dat voor elke nieuwe test alle formules gekopieerd moeten worden (zijn vele honderden regels per soort). Vooral voor de gebruikers die ermee moeten werken is dit erg lastig. Zijn er mogelijkheden om dit in een VBA codering op te lossen?

Anders ga ik de oplossing van jou gebruiken :thumb: , dan ga ik even kijken hoe ik dit voor de gebruikers goed kan oplossen.

Alvast heel erg bedankt voor de eventuele reacties.

Groetjes,

Danielle

 

[snb]

Een typisch geval van uitgebreid filter (advanced filter)
Verwijder in werkblad 'testresultaten' eerst kolom A.

Sub M_snb()
    With Sheets("testresultaten")
        .Cells(1, 30).CurrentRegion.ClearContents
        .Cells(1).CurrentRegion.Columns(3).AdvancedFilter 2, , .Cells(1, 30), True
    
        For Each it In .Columns(30).SpecialCells(2).Offset(1).SpecialCells(2)
            .cells(1,18)="Soort"
            .Cells(2, 18) = it
            .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 18).CurrentRegion, Sheets("Hoofdblad").Cells(Rows.Count, 1).End(xlUp).Offset(3)
        Next
    End With
End Sub

 

[Danielle22]

Hallo,

Ik heb mijn indeling iets aangepast (zie voorbeeld). Ik heb standaard 10 lege rijen tussen de blokken (in de praktijk zijn dit er wel meer). Kunnen nu ook de gegevens met een macro onder het juiste blok worden gezet (de blokken met een kleur staan vast en de nummer "soort" staat ook altijd gevuld)?

Ik kan dan zelf met een macro weer de lege rijen verwijderen en dan heb ik ook het gewenste resultaat

Hopelijk kunnen jullie mij op weg helpen.

In ieder geval alvast heel erg bedankt voor de eventuele reacties.

Groetjes,

Danielle.

Bekijk bijlage Voorbeeld kopie gegevens v1.xlsm

 

[snb]

Heb je mijn suggestie uitgeprobeerd ?

 

[Danielle22]

Hoi snb,

Bedankt voor je reactie.

Ja die heb ik getest (zie bijlage).

De macro komt ook aardig in de buurt, maar de kolommen staan vast. Dus onder de kolommen moeten de waardes uit "testresultaten" komen te staan.

Of kan ik je macro ook hiervoor aanpassen?

Groetjes,

Danielle

Bekijk bijlage Voorbeeld kopie gegevens met VBA.xlsm

 

[snb]

Dat is het aardige van macro's: die zijn aan te passen. Bestudeer eerst de code goed, dan lukt het je wel.

 

[Danielle22]

Hoi snb,

Ik zal de macro even bestuderen. Ik hoop dat ik er uit kom

Groetjes,

Danielle

 

[Danielle22]

Hallo,

Het opgelost met de volgende code:

Sub kopie()
Dim r As Range, adr As String
Application.ScreenUpdating = False
With Sheets("Hoofdblad").Columns(1)
    Set r = .Find("unique code")
    If Not r Is Nothing Then
        adr = r.Address
        Do
            r(4).Resize(10, 15).ClearContents
            With Sheets("testresultaten").Range("A1").CurrentRegion
                .AutoFilter Field:=3, Criteria1:=r(2).Value
                .Copy r(3)
                .AutoFilter
            End With
            Set r = .FindNext(r)
        Loop While r.Address <> adr
    End If
End With: Application.ScreenUpdating = True
End Sub

Heb wel hulp gehad, kwam er zelf toch niet helemaal uit

Groetjes,

Danielle

 

[snb]

Kijk nu eens wat er gebeurt als je de rode markering varieert (12, 13, 14 etc.)

Sub M_snb()
    With Sheets("testresultaten")
        .Cells(1, 30).CurrentRegion.ClearContents
        .Cells(1).CurrentRegion.Columns(3).AdvancedFilter 2, , .Cells(1, 30), True
    
        For Each it In .Columns(30).SpecialCells(2).Offset(1).SpecialCells(2)
            .cells(1,18)="Soort"
            .Cells(2, 18) = it
            .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 18).CurrentRegion, Sheets("Hoofdblad").Cells(Rows.Count, [COLOR="#FF0000"][B][SIZE=3]12[/SIZE][/B][/COLOR]).End(xlUp).Offset(3)
        Next
    End With
End Sub