regels opslaan in verschillende bestanden

[Mde]

Hallo,

Ik heb een bestand met verschillende namen.
Nu zoek ik een manier om per plaatsnaam, kolom N, een apart bestand te maken.
en daar in moeten alle gegevens in komen, kolom B t/m kolom O (hier leeg maar in werkelijk bestand gevuld)
De gegevens moeten worden opgeslagen als de naam die in kolom N staat.
Bestand template dacht ik te gebruiken als sjabloon, als dat nodig is

Bekijk bijlage test.xlsx Bekijk bijlage template.xlsx

 

[Mde]

Ik heb deze code gevonden op dit forum, http://www.helpmij.nl/forum/showthread.php/885785-Rijen-kopieren-naar-nieuw-werkblad-ahv-celwaarde
Deze werkt op zich goed alleen krijg hem niet werkend op kolom N.
iemand een idee hoe ik dit kan oplossen?

Sub Transfer_Uniques()
    Dim a(), i As Long, n As Long, x, lr As Long, j As Long
    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    n = 1
    ReDim a(1 To n)
    a(1) = Cells(5, 2)
    i = 6
    While Not IsEmpty(Cells(i, 2))
        x = Cells(i, 2).Value
        If IsError(Application.Match(x, a, 0)) Then
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = x
        End If
        i = i + 1
    Wend
    For j = LBound(a) To UBound(a)
        With Range("B1:B" & lr)
            .AutoFilter Field:=1, Criteria1:=a(j)
            On Error Resume Next
            If Sheets("AB" & a(j)) Is Nothing Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AB" & a(j): _
            Sheets("Blad1").Range("A4:O4").Copy Range("A1"): _
            Sheets("Blad1").Select
            On Error GoTo 0
        End With
    Range("A4:O" & lr).SpecialCells(xlCellTypeVisible).Copy Sheets("AB" & a(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    ActiveSheet.AutoFilterMode = False
    Next j
    Application.ScreenUpdating = True
End Sub

BVD

 

[gast0660]

Hoi,
Probeer deze eens uit
Splits eerst en sla daarna op

 

[Mde]

Hoi gast0660,

ziet er goed uit, zie dat je de plaatsnamen vast in de macro hebt staan dit is niet de bedoeling omdat er ook andere namen voor kunnen komen.
Is hier een oplossing voor?
In ieder geval bedankt voor deze oplossing

 

[gast0660]

Hoi,
Je kan een lijstje maken in een blad
In aangepaste bijlage is dit blad 2
En je past dan de code aan zie ook bijlage
Verder heb ik nog een kleine aanpasing gemaakt, als de map waar de werkbladen worden opgeslagen al bestaat krijg je nu een Msg box ipv een foutmelding.
Verder heb ik nog een stukje code erbij gezet, je kiest uit het lijstje in blad 2 de plaatsnamen waarvan er nog geen tabblad is gemaakt en die worden dan automatisch aangemaakt.
Hopelijk kan je hiermee verder, een betere oplosing weet ik niet zo direct

 

[Mde]

Hoi,

Bedankt zal even testen hoe het gaat in mijn bestand.
bedankt voor de moeite:thumb:

 

[wieter]

Slecht weer & verveling = bestandje maken
Bij nieuwe invoer wordt autom. nieuw tabblad gemaakt.
Je ziet maar of je er iets mee kan.

 

[VenA]

Begin bij voorkeur in A1 met je tabel en gebruik geen lege kolommen dit maakt de de code alleen maar ingewikkelder/meer op maat.
Het is mij niet geheel duidelijk of je de gegevens bijhoudt op Blad1 en dit wil verdelen naar de verschillende tabje of dat er na een actie Blad1 leeg gemaakt wordt en de verschillende tabjes aangevuld moeten worden. Ik ben maar even van het eerste uit gegaan.
Ook is het niet echt duidelijk of je verschillende tabje binnen het bestaande bestand wil hebben of dat er voor elke plaats een nieuw bestand aangemaakt moet worden(in de titel staat het wel maar in de geplaatste code niet). Ik ben er maar even vanuit gegaan dat het binnen hetzelfde bestand moet.

Sub VenA()
Dim ar, j, c00
Application.ScreenUpdating = False
With Sheets("Blad1")
    ar = .Columns(13).SpecialCells(2)
    For j = 2 To UBound(ar)
        If InStr(c00, ar(j, 1)) = 0 Then c00 = c00 & "|" & ar(j, 1)
    Next j
    ar = Split(Mid(c00, 2), "|")
    For j = 0 To UBound(ar)
        If IsError(Evaluate(ar(j) & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = ar(j) Else Sheets(ar(j)).Cells.Clear
        With .Cells(1).CurrentRegion
            .AutoFilter 13, ar(j)
            .Copy Sheets(ar(j)).[A1]
            .AutoFilter
        End With
    Next j
End With
End Sub

 

[Mde]

Hoi,

Allen bedankt voor de input.
die van V en A was wat ik zocht:thumb:

 

[VenA]

Graag gedaan. Maar mij ontgaat het doel om als je gegevens verzamelt in een 'tabel' dit uit te splitsen naar verschillende tabjes. Met een filter op de 'tabel' of met een draaitabel kan je het bestand beperken tot twee tabjes.

@wieter,

Als de verveling of slecht weer, wat nu hier het geval is, weer toeslaat. Kijk eens naar

Private Sub CommandButton1_Click()
If ComboBox3.Value = "" Then
    MsgBox "Je moet een plaats kiezen"
    Exit Sub
End If
ar = Array(ComboBox3.Value, TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, ComboBox2.Value, TextBox6.Value, _
    TextBox5.Value, TextBox7.Value, TextBox8.Value, TextBox9.Value, TextBox10.Value, TextBox11.Value)
Sheets("Invoer").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 13) = ar
Unload Me
End Sub

Of de volgorde geheel correct is mag je zelf even bekijken

 

[wieter]

Tja VenA,
Ik weet het, werken met array's, maar ik ben er niet zo vertrouwd mee.
Het verbetert zeker de snelheid, en het is veeeel minder intyp-werk.

 

[Mde]

Het gaat hier om verschillende verenigingen die de tijden terug moeten krijgen voor hoe laat de deelnemers er moeten zijn.