copieeren naar blad met zelfde naam

Status
Niet open voor verdere reacties.
K

kattenbe

Gebruiker
Lid geworden
12 jan 2016
Berichten
45
Besturingssysteem
Windows
Office versie
365
Goede avond,
Ik krijg door gebruik te maken van een Userform de data keurig op/in Blad4 (DataTot).
Nu zou ik graag zien (en zoek daar de VBA code van) dat wanneer ik het programma afsluit dat de betreffende rijen automatisch worden weggeschreven naar de Bladen met dezelfde naam als de namen van kolom A.
Tevens zal het zo zijn dat er in de nabije toekomst meer codes en dus bladen bij zullen komen.
Ik heb veel helpdesken?? en op You Tube gezocht maar daar kan ik het niet vinden.

Ik hoop dat u mij kunt helpen?

Bij voorbaat dank
Kattenbe
 

Bijlagen

  • Copy Once Paste to Specific Worksheet.xlsm
    25,6 KB · Weergaven: 22
Ik zie geen Userform en waarom wil je alles in verschillende tabjes zetten?
 
Hoi,
Zoiets?
Code in de ThisWorkbook module.
Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
On Error GoTo Fout
    Lr = Sheets("DataTot").Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To Lr
            Nm = Sheets(Cells(i, "A").Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
            Rows(i).Copy Destination:=Sheets(Cells(i, "A").Value).Rows(Nm)
        Next
    Rows("2:" & Rows.Count).ClearContents
Exit Sub
Fout:
MsgBox "U heeft geen blad met de naam  " & Cells(i, "A").Value, vbCritical, "Fout"
Application.ScreenUpdating = True
End Sub
 
Ik zou het autofilter gebruiken.

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  With Sheets("Datatot").Cells(1).CurrentRegion
    For Each sh In Sheets
      If sh.Name <> .Parent.Name Then
        .AutoFilter 1, sh.Name
        .Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Offset(1).EntireRow.Delete
      End If
    Next sh
    .Parent.AutoFilterMode = 0
    MsgBox IIf(.Cells(2, 1) <> "", "niet ", "") & "alles verplaatst"
  End With
  ActiveWorkbook.Close -1
End Sub
 
Heren hartelijk dank, beide oplossingen werken (ik zou zeggen van zelf sprekend) natuurlijk prima.

Is het veel gevraagd de code zo aan te passen dat wanneer er een bladnaam niet bestaat dat er gevraagd wordt om een dat betreffende blad als nog aan te (willen) maken?
 
De reden is dat ieder tabblad de gegevens krijgt van een in een poule (biljart) gespeelde partijen.
Ik heb te maken met maximaal 15 poules van 3 spelers die spelen de partijen over een aantal weken.
En door een druk op een knop kan ik direct naar de gegevens van een bepaalde poule kan.
 
Waarom schrijf je het dan niet gelijk vanuit het formulier naar de juiste tab? Even de 15 juiste tabjes aanmaken en je hoeft nergens op te controleren.

Maar goed. Een van de vele mogelijkheden.

Code: 
Sub VenA()
  With Sheets("Datatot").Cells(1).CurrentRegion
    ar = .Cells(1).Resize(, .Columns.Count)
    Set d = .Offset(, .Columns.Count + 2)
    .Columns(1).AdvancedFilter xlFilterCopy, , d.Resize(, 1), True
    ar1 = d.Cells(1).CurrentRegion
    d.Cells(1).CurrentRegion.Clear
    For j = 2 To UBound(ar1)
      If IsError(Evaluate("'" & ar1(j, 1) & "'!A1")) Then
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = ar1(j, 1)
        Cells(1).Resize(, UBound(ar, 2)) = Application.Transpose(ar)
      End If
      .AutoFilter 1, ar1(j, 1)
      .Offset(1).Copy Sheets(ar1(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
      .Offset(1).EntireRow.Delete
    Next j
    .Parent.AutoFilterMode = 0
  End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan