• 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.

vba kopieren plakken met voorwaarden

Status
Niet open voor verdere reacties.
ik had .Autofilter verandert naar 9 omdat ik dat ook zag bij Ahulpje
begrijpt nog niet direct waarom 6 en niet 9
 
Jec - Ahulpje,
heb nog eens jullie hulp nodig
alles werkt perfect maar nu had ik graag in mijn tabblad "in" kolom "g" proper gemaakt
ik wil dat alle tekst tem ":" verwijdert wordt
via een extra kolom en functie =Rechts zou het kunnen doch wil het graag in dezelfde kolom aangepast
voorbeeld bestandje wat aangepast
 

Bijlagen

  • hulp-verplaatsen_jec.xlsm
    29,2 KB · Weergaven: 10
Hallo,

Dat is ook heel makkelijk met power query te verwezenlijken.
Maar ja, je bent met VBA verder aan de gang gegaan.
Jammer want in jou specifiek geval was je met power query al lang met je origineel bestand aan het werk geweest.
 
Voeg deze regel toe direct onder "Dim ar"

Code: 
 Sheets("data").Columns("G:G").Replace ": ", ""

Maar misschien heeft JEC wel een mooiere oplossing.
 
Ahulpje
hij verwijdert de ":" doch ik wou alle tekst die voor : staat ook weg
alleen die varieert in lengte
 
Code: 
Sheets("data").Columns("G:G").Replace "*;", "", 2
 
Als er niet altijd een numeriek deel na de dubbele punt staat dan wil je misschien ook de spatie na de dubbele punt verwijderd zien, dan wordt het:

Code: 
Sheets("data").Columns("G:G").Replace "*: ", "", xlPart
 
nu had ik er graag een controle in gehad
de data is een manuele download met als gevolg dat er een fout kan gebeuren
kan script aangepast worden waarbij hij kolom E in "data" gebruikt als controle veld (dit is namelijk een unieke tekst)
als die al voorkomt in tabblad "in" of "uit" dan velden niet kopiëren.
 
Moet dit per rij gecontroleerd worden of kan de hele batch afgekeurd worden als de eerste rij al een dubbeling oplevert?
En plaats hier even je meest recente versie.
 
controle moet gebeuren op rij
in bijlage voorbeeld file aangepast
in tabblad data zou de zwarte moeten toegevoegd worden in "uit"
de rode zou niet meer mogen toegevoegd worden daar deze al bij "in" staat.
de controle gebeurd op Kolom "E" in data = kolom "D" in andere tabbladen

Code: 
Sub inuit()
 Dim ar
 ar = Sheets("data").Cells(1).CurrentRegion.Value2
 ar = Application.Index(ar, Evaluate("row(2:" & UBound(ar) & ")"), Array(5, 6, 9, 7, 18))
 Application.ScreenUpdating = False
 
 With Sheets("in").Range("D1")
   .Parent.Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(ar), UBound(ar, 2)) = ar
    With .CurrentRegion
      .AutoFilter 6, "<0"
      .Offset(1).EntireRow.Delete
      .AutoFilter
    End With
 End With
 With Sheets("uit").Range("D1")
   .Parent.Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(ar), UBound(ar, 2)) = ar
    With .CurrentRegion
      .AutoFilter 6, ">0"
      .Offset(1).EntireRow.Delete
      .AutoFilter
    End With
 End With
 Range("A2:R200").ClearContents
End Sub
 

Bijlagen

  • hulp-verplaatsen.xlsm
    28,1 KB · Weergaven: 7
Zie bijlage.
 

Bijlagen

  • hulp-verplaatsen2.xlsm
    35,2 KB · Weergaven: 8
Removeduplicates toegevoegd.

Code: 
Sub inuit()
 Dim ar, sht
 ar = Sheets("data").Cells(1).CurrentRegion.Offset(1).Value2
 ar = Application.Index(ar, Evaluate("row(1:" & UBound(ar) & ")"), Array(5, 6, 9, 7, 18))
 Application.ScreenUpdating = False
 
 For Each sht In Sheets(Array("in", "uit"))
   With sht.Range("D1")
     .Parent.Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(ar), UBound(ar, 2)) = ar
      With .CurrentRegion
        .AutoFilter 6, IIf(sht.Name = "in", "<0", ">0")
        .Offset(1).EntireRow.Delete
        .AutoFilter
        .RemoveDuplicates Array(4, 5, 6, 7, 8), 1
      End With
   End With
 Next
 Sheets("data").Range("A2:R200").ClearContents
End Sub
 
Laatst bewerkt:
@JEC
Een mooie oplossing.
Maar je macro loopt vast op UBound(ar, 2) als er maar één rij in het werkblad data staat, ar is dan een 1-dimensionale array.
 
Inderdaad! Eerste twee regels van de code zijn iets aangepast.
 
[Zeurmodus]

En nu deze er nog even tussen, want hij crasht nu als er geen rijen in "data" staan:
Code: 
 If Sheets("data").Range("D2") = vbNullString Then Exit Sub

En als er meer dan 200 rijen in "data" kunnen staan dan wellicht afsluiten met:
Code: 
    Sheets("data").Rows("2:" & Range("E2").End(xlDown).Row).Delete Shift:=xlUp
    Application.ScreenUpdating = True
[/Zeurmodus]
 
Dat kan allemaal. Alle controles ga ik er niet inbouwen uiteraard.
 
Was ook meer bedoeld voor de TS, met jouw code mag hij/zij in zijn/haar handjes wrijven!
 
Hopelijk begrijpt TS het een beetje:)
 
Of gewoon klassiek gebruik van Excel (ook met de hand mogelijk).

Code: 
Sub M_snb()
  With Blad1
    .Cells(1, 26) = "aantal"
    .Cells(2, 26) = ">0"
    .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 26).CurrentRegion, Blad2.Cells(1).CurrentRegion.Offset(, 3).Resize(, 5)
    .Cells(2, 26) = "<0"
    .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 26).CurrentRegion, Blad3.Cells(1).CurrentRegion.Offset(, 3).Resize(, 5)
   End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan