Cellen met een x-waarde kopieëren naar tabblad met een x waarde

[SanderMulders]

Beste lezers,

Ik wil graag in Excel een aantal cellen met een bepaalde waarde kopiëren naar een ander tabblad (in hetzelfde werkblad) met een bepaalde waarde.
Voorbeeld:
Tabblad "Input" heeft een aantal gegevens.
Nu wil ik graag dat van alle artikelen de afzet naar tabllad "afzet" gekopieerd word en datzelfde voor Afzet en Breuk.


Het resultaat wordt dan:


Ik heb dit geprobeerd met onderstaande marco alleen kopieerd hij de gegevens van in Cel A1.
Het lukt mij niet op deze bijvoorbeeld in cel A2 te kopiëren en ik moet voor elke gegeven een aparte marco activeren.
Kan dit niet in 1x automatisch?

Sub Omzet()
Dim rij As Long
Dim n As Long
Dim Src As Worksheet
Dim trg As Worksheet
Set Src = Sheets("Input")
Set trg = Sheets("Omzet")

Application.ScreenUpdating = False
rij = trg.[A65536].End(xlUp).Row
For n = 1 To Blad1.[A65536].End(xlUp).Row
    If Cells(n, "B").Value = "Omzet" Then
        Range(Cells(n, "A"), Cells(n, "L")).Copy
        trg.Cells(rij, "A").PasteSpecial
        rij = rij + 1
    End If
    Next
End Sub

Bekijk bijlage Test.xlsx

Alvast bedankt voor jullie hulp en tijd.

 

[snb]

Plaats een Excel voorbeeldbestand in plaats van plaatjes.
Zet de VBA code svp tussen code tags.

 

[SanderMulders]

Hi SNB,

Zie originele bericht voor nieuwe test bijlagen.

 

[VenA]

Bv met het autofilter

Sub VenA()
Application.ScreenUpdating = False
For Each sh In Sheets
  If sh.Name <> "Input" Then
    With Sheets("Input").Range("A1:N" & Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row)
    .AutoFilter 2, sh.Name
    .Copy sh.Cells(1)
    .AutoFilter 2
    End With
  End If
Next
End Sub

 

[SanderMulders]

Hi,

Bedankt voor je reactie maar met de auto filter kan ik idd selecteren wat ik nodig heb maar dan moet ik alsnog alles handmatig kopiëren naar de tabbladen.

Graag zou ik dit willen automatiseren zover dat mogelijk is.

 

[VenA]

Je kan ook eerst de code testen.

 

[SanderMulders]

Hi,

Dat heb ik gedaan er komt dan een filter in beeld maar verder weinig.
Wellicht dat ik iets verkeerd overneem?

Wat zou het precies moeten laten zien?

Alvast bedankt,

 

[VenA]

Heb je ook op 1 van de drie doeltabjes gekeken?

 

[SanderMulders]

Ja, hij laat een autofilter zien die zover ik kan zien hetzelfde is als de snelkoppeling in de werkbalk.
Dus met alle respect zie ik de toegevoegde waarde nog niet helemaal.

Mocht je het willen uitleggen heel graag,

Iig bedankt voor je genomen moeite zover.

 

[VenA]

Klik op de blauwe knop.

 

[SanderMulders]

Kijk, dat werkt super bedankt.

Nu loop ik alleen tegen het probleem dat wanneer ik dit in mijn originele bestand wil toepassen, dat alleen de bovenste regel wordt gekopieerd. Ik heb de code overgenomen en boven aan mijn script geplakt. De marco heb ik toegewezen aan een button.

Moet ik nog bereiken ofzo aanpassen?

 

[VenA]

Wat staat er in kolom A en Kolom B van het originele bestand?

 

[SanderMulders]

Goedemorgen,

De input pagina van het originele bestand ziet er uit als op de afbeelding.
Ik heb onze echte artikelen in het voorbeeld vervangen door artikel x en y.

De bedoeling is om uiteindelijk deze opzet te blokkeren en dan men alleen de cijfers opnieuw kan plakken in dit bestand.



Mijn code ziet er als volgt uit nu:

Sub Auto()
Application.ScreenUpdating = False
For Each sh In Sheets
  If sh.Name <> "Input" Then
    With Sheets("Input").Range("A1:K" & Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row)
    .AutoFilter 2, sh.Name
    .Copy sh.Cells(1)
    .AutoFilter 2
    End With
  End If
Next
End Sub


Sub Dagprijzen()
Dim rij As Long
Dim n As Long
Dim Src As Worksheet
Dim trg As Worksheet
Set Src = Sheets("Input")
Set trg = Sheets("Dagprijzen")

Application.ScreenUpdating = False
rij = trg.[A65536].End(xlUp).Row
For n = 1 To Blad1.[A65536].End(xlUp).Row
    If Cells(n, "B").Value = "Market" Then
        Range(Cells(n, "A"), Cells(n, "L")).Copy
        trg.Cells(rij, "A").PasteSpecial
        rij = rij + 1
    End If
    Next
End Sub

Sub GIPprijzen()
Dim rij As Long
Dim n As Long
Dim Src As Worksheet
Dim trg As Worksheet
Set Src = Sheets("Input")
Set trg = Sheets("GIPprijzen")

Application.ScreenUpdating = False
rij = trg.[A65536].End(xlUp).Row
For n = 1 To Blad1.[A65536].End(xlUp).Row
    If Cells(n, "B").Value = "Provisional price" Then
        Range(Cells(n, "A"), Cells(n, "L")).Copy
        trg.Cells(rij, "A").PasteSpecial
        rij = rij + 1
    End If
    Next
End Sub

Sub Consumption()
Dim rij As Long
Dim n As Long
Dim Src As Worksheet
Dim trg As Worksheet
Set Src = Sheets("Input")
Set trg = Sheets("Consumptie")

Application.ScreenUpdating = False
rij = trg.[A65536].End(xlUp).Row
For n = 1 To Blad1.[A65536].End(xlUp).Row
    If Cells(n, "B").Value = "Consumption" Then
        Range(Cells(n, "A"), Cells(n, "L")).Copy
        trg.Cells(rij, "A").PasteSpecial
        rij = rij + 1
    End If
    Next
End Sub

Hopelijk weten jullie de aanpassing die het werkend maakt.

Groetjes

 

[VenA]

Als de namen van de tabbladen anders zijn dan waarop je wil filteren dan werkt het natuurlijk niet.

Probeer het zo eens.

Sub VenA()
Application.ScreenUpdating = False
ar = Array("Market", "Dagprijzen", "Provisional price", "GIPprijzen", "Consumption", "Consumptie")
For j = 0 To UBound(ar) Step 2
    With Sheets("Input").Range("A1:N" & Sheets("Input").Cells(Rows.Count, 1).End(xlUp).Row)
    .AutoFilter 2, ar(j)
    .Copy Sheets(ar(j + 1)).Cells(1)
    .AutoFilter 2
    End With
Next j
End Sub

 

[snb]

Ik zou het zo schrijven:

Sub M_snb()
  ar = Array("Market", "Dagprijzen", "Provisional price", "GIPprijzen", "Consumption", "Consumptie")
 
  With Sheets("Input").cells(1).currentregion.resize(,14)
    For j = 0 To UBound(ar) Step 2
      .AutoFilter 2, ar(j)
      .Copy Sheets(ar(j + 1)).Cells(1)
      .AutoFilter
    Next
 End With
End Sub

 

[SanderMulders]

Hi Vena,

Bedankt het werkt nu zoals ik graag wil.

Bedankt voor jullie moeite!

 

[SanderMulders]

Extra vraagje

Hi allen,

Voor mij een wat lastiger iets maar voor jullie waarschijnlijk een eitje.
Ik heb wat gegevens staan op het eerste tabblad. Deze verander ik dagelijks a.h.v. bestellingen.

Wat ik graag zou willen is: Als ik op tabblad 1 een laadnummer ingeef dat deze automatisch wordt gekopieerd naar het tweede tabblad in kolom Y (laadref.)
En dat met alle gegevens op tabblad input. Het kan zijn dat er de ene dag meer gegevens worden ingevuld en de andere dag minder.

De volgorde van beide tabbladen moet gelijk blijven.

Laadplaats moet gekopieerd worden naar: kolom G onder laadnaam
Product moet gekopieerd worden naar: kolom D onder Product
Losnummer moet gekopieerd worden naar: kolom AA los.ref
Leverancier moet gekopieerd worden naar: kolom H laadadres
Lokoatie moet gekopieerd worden naar: kolom M losnaam

als iemand een idee heeft hoe dit makkelijk en snel kan hoor ik het graag zodat ik hiermee aan de slag kan.

Alvast bedankt voor jullie tijd en tips.

Zie bijlagen voor het voorbeeld bestand.

 

[snb]

Gebruik in ieder werkblad altijd cel A1.
Hoe groter de overeenkomst tussen werkbladen hoe minder code je nodig hebt.
Fora zijn geen gratis software-firma's.

 

[VenA]

Bv

Sub VenA()
ar = Sheets("Input").Cells(4, 2).CurrentRegion
ReDim ar1(UBound(ar) - 2, 26)
For j = 2 To UBound(ar)
  ar1(j - 2, 3) = ar(j, 2)
  ar1(j - 2, 7) = ar(j, 4)
  ar1(j - 2, 10) = ar(j, 1)
  ar1(j - 2, 12) = ar(j, 5)
  ar1(j - 2, 24) = ar(j, 6)
  ar1(j - 2, 26) = ar(j, 3)
Next j
Sheets("Output").Cells(Rows.Count, 4).End(xlUp).Offset(1, -3).Resize(UBound(ar1) + 1, UBound(ar1, 2) + 1) = ar1
End Sub

 

[SanderMulders]

VenA: Wederom onzettend bedankt voor je hulp!!