• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

kopiëren en verplaatsen met een twist

Status
Niet open voor verdere reacties.
T

Tijsss

Gebruiker
Lid geworden
25 jan 2012
Berichten
46
Beste mensen,

Ik heb een vraagje over Vba en ik kom er zelf niet uit. Zie voorbeeldbestandje

Is het mogelijke met VBA (Macro Knop)om de verschillende waarde(1) te kopiëren(voorblad) naar de juiste tabbladen. In deze tabbladen de bestaande waarde(2) te verplaatsten naar een nieuwe kolom (A1 wordt B1, B1 wordt C1 enz) en de gekopieerde waarde(1) van "Voorblad" op A1 te zetten.

Ik hoop dat het duidelijk is met het voorbeeldbestandje.

Alvast bedankt
Tijs
 

Bijlagen

  • Voorbeeldbestand.xlsm
    78,8 KB · Weergaven: 37
Zoiets?
Code: 
Sub VenA()
  Application.ScreenUpdating = False
  For Each sh In Sheets
    If sh.Name <> "Voorblad" Then
      sh.Columns(1).Insert
      With Sheets("Voorblad").Cells(1).CurrentRegion
        .AutoFilter 1, sh.Name
        .Offset(1, 1).Resize(, 1).Copy sh.Cells(1)
        .AutoFilter 1
      End With
    End If
  Next sh
End Sub
 
Who dat is snel!

Dank je VenA, dit is idd wat ik wou.

Een klein vervolg vraagje. De gegevens op het voorblad staan niet in kolom A en B, maar is kolom S en T. Welke cijfertje moet er veranderd worden?

Alvast bedankt,
Tijs
 
Code wordt gemaakt obv van een voorbeeldbestand. Als dit bestand niet gelijk is aan de werkelijkheid dan mag je eerst zelf even aan de slag om te begrijpen wat het de code doet.

Het aanpassen is afhankelijk van hoe de rest er uitziet. kolom A is kolom 1, kolom S is kolom 19. Dus je zal met de offset en de te filteren kolom aan de gang moeten. Als er een kolom leeg is in de range A:S dan werkt With Sheets("Voorblad").Cells(1).CurrentRegion niet en moet je weer wat anders bedenken. Mocht je er niet uitkomen plaatst dan een gelijkend voorbeeld en waar het misgaat. Een andere helper ik of kan wel een passende oplossing plaatsen maar dan leer je er niets van of we mogen bij elke wijziging weer wat aanpassen.;)
 
Beste VenA,

Dit verklaart een heleboel "Als er een kolom leeg is in de range A:S dan werkt With Sheets("Voorblad").Cells(1).CurrentRegion niet en moet je weer wat anders bedenken"

Want het gaf mij niet de juiste resultaten ;)

Ik kan er omheen werken door hem naar een ander blad te verwijzen(resultaten), zie voorbeeld. Probleem nu is, dat het "voorblad" en andere "Sheets" standaard ook een kolom opschuift en dat is niet de bedoeling :(. Is het mogelijke alleen de gewensten Sheets (Groenten en fruit) de marco toe te passen en de rest van de Sheets niet?
 

Bijlagen

  • Voorbeeldbestandv0.1.xlsm
    22,4 KB · Weergaven: 29
Code: 
Sub VenA()
  Application.ScreenUpdating = False
  For Each sh In Sheets(Array("Fruit", "Groenten"))
    sh.Columns(1).Insert
      With Sheets("Resultaten").Cells(1).CurrentRegion
        .AutoFilter 1, sh.Name
        .Offset(1, 1).Resize(, 1).Copy sh.Cells(1)
        .AutoFilter 1
      End With
  Next sh
End Sub
 
Met uitgebreid filter:
Code: 
Sub M_snb()
    With Sheets("voorblad")
        For Each it In Sheets
          If InStr("VoorbladResultaten", it.Name) = 0 Then
             it.Columns(1).Insert
             it.Cells(1) = .Cells(1, 2)
             .Cells(1, 4).Resize(2) = Application.Transpose(Array(.Cells(1).Value, it.Name))
             .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 4).CurrentRegion, it.Cells(1)
           End If
        Next
        .Cells(1, 4).CurrentRegion.ClearContents
    End With
End Sub
 
Beide super bedankt voor de antwoorden, je hebt me een heel stuk verder gelopen!

Een raar bijverschijnsel in mijn originele bestand is dat de vba hem als formule overneemt (kopiërend),
is het met een kleine aanpassing mogelijk dat vba code hem als (vaste)waarde kopiërend ipv van de formule?
 
Volgens mij worden gefilterde gegevens altijd als waarden geplakt.
 
Beste VenA & snb,

Het is allemaal gelukt! Bedankt voor jullie hulp!

Gr Tijs

Ps ik zal hem als opgelost aanvinken
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan