Rijen kopieren naar nieuw werkblad obv waarde kolom

Status
Niet open voor verdere reacties.
P

Patty77

Nieuwe gebruiker
Lid geworden
2 okt 2017
Berichten
2
Goede avond,

Ik zit met het volgende... Ik krijg maandelijks een hele set aan data aangeleverd die ik moet opsplitsen in een honderdtal verschillende bestanden. Handmatig kost dit ontzettend veel tijd en ik zou dit graag met een Macro/VBA op willen lossen. Ik kom overal losse puzzelstukjes tegen op internet, maar krijg hem niet in elkaar.

Wat ik wil: ik heb een voorbeeld bestand toegevoegd en ik wil graag dat er voor elke zelfde waarde in kolom A een aparte tab wordt aangemaakt met dezelfde naam, die alle rijen met deze waarde in kolom A kopieert naar een apart werkblad. Dus bijvoorbeeld alle regels die in kolom A de waarde 1550 hebben, moeten in een tabblad met de naam 1550 komen onder elkaar. Ik heb een tweede tab toegevoegd om te laten zien wat ik graag als resultaat wil zien.

Ik ben benieuwd!

Bedankt alvast.
 

Bijlagen

  • Voorbeeld.xlsx
    9,4 KB · Weergaven: 22
Hoi Patty, welkom op het forum:)
Zoiets?
 

Bijlagen

  • blabla.xlsb
    22,8 KB · Weergaven: 36
Wauw ja! Super! Het werkt precies zoals ik wilde. Heel erg bedankt, dit gaat mij echt zoveel tijd schelen en een goeie verbeterslag hier!
 
Met een iets andere variant.

Code: 
Sub VenA()
Dim j As Long, it, ar, d
  With Sheets("Inputsheet")
    ar = .Cells(1).CurrentRegion
    Set d = CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      d.Item(ar(j, 1)) = ""
    Next j
    For Each it In d.keys
      If IsError(Evaluate("'" & it & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = it Else Sheets(CStr(it)).Cells(1).CurrentRegion.ClearContents
      .Range("Z1:Z2") = Application.Transpose(Array("Kostenplaats", it))
      .Cells(1).CurrentRegion.AdvancedFilter xlFilterCopy, .Range("Z1:Z2"), Sheets(CStr(it)).Cells(1)
      .Range("Z1:Z2").ClearContents
      Sheets(CStr(it)).Columns.AutoFit
    Next it
  End With
End Sub
 

Bijlagen

  • Voorbeeld.xlsb
    18,4 KB · Weergaven: 24
Of:

Code: 
Sub M_snb()
  With Sheets("Inputsheet")
    .Cells(1).CurrentRegion.Columns(1).AdvancedFilter 2, , .Cells(1, 40), -1
    sn = .Cells(1, 40).CurrentRegion
    
    For j = 2 To UBound(sn)
      .Cells(2, 40) = sp(j, 1)
       If Not Evaluate("isref(" & sn(j, 1) & "!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = sn(j, 1)
      .Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 40).Resize(2), Sheets(Format(sn(j, 1))).Cells(1)
    Next
    
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan