Macro kopieer cellen naar ander tabbad van rij als kolom G Ja is

[wekkanz]

Hallo,

Om een werkproces te optimaliseren, ben ik opzoek naar een macro waarmee automatisch geselecteerde cellen naar een ander tabblad worden gekopieerd als cel G ja is.

Momenteel gebruik ik een Macro die de gehele regel kopieer echter vertroebeld hiermee het overzicht ik heb deze geprobeerd aan te passen maar mij ontbreekt het nog aan voldoende kennis op dit op te lossen.

In een module heb ik de volgende code:

Sub Overzetten()
    ActiveCell.EntireRow.Copy Destination:=Sheets("blad2").[A65536].End(xlUp).Offset(1, 0) 
    [A1].Select 'Ga naar cel A1
    Sheets("blad2").Columns("A:G").AutoFit 
    MsgBox ("Taak is succesvol overgezet")
End Sub

OP het tabblad 1 heb ik de volgende code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 8 Then Exit Sub 
    If Target.Value = "ja" Then 
    Target.Offset(0, 1).Value = Date 
            Call Overzetten 
    End If
End Sub

Ik heb een voorbeeldje gemaakt met wat mijn bedoeling is.
Op blad 1, staat een reeks A tot G wanneer G Ja is word en in cel H een datum geplaatst.
In kolom G kan ja of nee geselecteerd worden, als er ja word geselecteerd, is de bedoeling dat van de zelfde regel cel A,B, F en G naar tabblad 2 op de eerst volgende lege regel word gekopieerd.

Maar dan dan in de volgende cellen:

A = A
B = B
F = C
G = D
En in cel E op tabblad 2 automatisch een datum komt te staan.

Kan iemand mij helpen hoe ik dit kan bewerkstelligen?

 

[JEC.]

Op Tabblad 1:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim j As Long
For i = 2 To 30
    If Range("G" & i) = "ja" Then
        Range("H" & i) = Date
    End If
Next i

j = 2
For i = 2 To 30
    If Sheets("Blad1").Cells(i, 8) <> "" Then
        Sheets("Blad2").Cells(j, 1) = Sheets("Blad1").Cells(i, 1)
        Sheets("Blad2").Cells(j, 2) = Sheets("Blad1").Cells(i, 2)
        Sheets("Blad2").Cells(j, 3) = Sheets("Blad1").Cells(i, 6)
        Sheets("Blad2").Cells(j, 4) = Sheets("Blad1").Cells(i, 7)
        Sheets("Blad2").Cells(j, 5) = Sheets("Blad1").Cells(i, 8)
        
        j = j + 1

    End If
Next i
End Sub

 

[wekkanz]

Hartelijk dank voor de snelle reactie, ik waardeer tenzeerste uw hulp!
Ik kan uw code redelijk volgens, maar ik begrijp alleen de j = 2 en j = j + 1 niet, kunt u mij misschien uitleggen waar dit voor staat?

 

[JEC.]

Dat zorgt ervoor dat de regels onder elkaar worden gekopieerd. Als je die j = j + 1 weg zou halen (en alleen met i zou werken) wordt nummer 11 op regel 11 gekopieerd op tabblad 2.

 

[VenA]

In een .xlsx staan geen macro's. Om iedere keer alle rijen af te lopen lijkt mij nogal vertragend. De datum steeds aanpassen zal ook wel niet de bedoeling zijn. Waarom dezelfde gegevens op 2 tabjes moeten staan zal een reden hebben? Filteren of een draaitabel gebruiken lijkt mij efficiënter.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 7 And Target.Row > 1 And Target.Count = 1 Then
    If Target.Value = "ja" Then
      Application.EnableEvents = False
      Target.Offset(, 1) = Date
      Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = Application.Index(Cells(Target.Row, 1).Resize(, 8), 0, Array(1, 2, 6, 7, 8))
      Application.EnableEvents = True
    End If
  End If
End Sub

 

[wekkanz]

Dankje wel VenA,
Goed dat je het vraagt, ik zal eerst even uitleggen waarom ik voor deze macro heb gevraagd;
Het originele document bevat 34 ingevulde kolommen die gevuld word dmv van een userform, in soms situaties moet er een extra handeling uitgevoerd worden door een andere collega waarbij extra gegevens moet toevoegen.
Wanneer deze in blad 1 worden toegevoegd is het werk niet meer overzichtelijk.

Waardoor mijn gedachte om de betreffende regel met enkel de benodigde informatie over te schrijven naar tabblad 2.
80% van deze werk inhoud komt van tabbald 1 maar er kan soms ook werk komen van een ander werkproces binnenkomen waardoor ik een userform heb gemaakt die in tabblad 2 een nieuwe regel kan aanmaken.
Zodat op tabblad 2 de betreffende info overzichtelijk bij elkaar staat als nieuwe werkinhoud overzichtelijk blijft.
Mijn collega ziet wat hij of zei moet doen en kan extra info toevoegen.

De datum had ik gevraagd, zodat ik kan zien en leren hoe ik dit soort commando's moet opstellen en dat ik hiermee de macro zelf passend kan maken zodat ik hiervan kan leren.

Je opmerking van een draaitabel is ook geen gek idee, ik vraag me alleen af op blad 1 worden wekelijks nieuwe regels aangemaakt het bereik van het draaitabel wekelijks moeten aanpassen toch? Ik vraag dit omdat collega's van mij niet zo excel vaardig zijn waardoor gegevens en koppelingen makkelijk zoek raken...

Nu ben ik sinds afgelopen december bekend geworden met VBA en Macro's misschien ben ik een beetje te enthousiast met programmeren en het oplossen en inzichtelijk maken van werkprocessen, mag ik vragen wat jij zou doen als je mij was als dit zo leest?

 

[JEC.]

Wanneer je een draaitabel van een tabel maakt, kunnen de gegevens automatisch ververst worden. Het bereik hoef je niet telkens aan te passen.

 

[wekkanz]

Ok dankje wel voor de snelle reactie! Ik ga eens testen misschien maak ik het ook te moeilijk

 

[wekkanz]

Het filteren met een draaitabel werkt inderdaad goed, dankje wel!

Alleen wanneer ik gegevens wil toevoegen aan de regel in de draai tabel, worden deze niet mee genomen.

Ik ben aan het bedenken hoe ik het aanvullen in het draaitabel.
Wat zou jij adviseren wat kan ik het beste kan doen?

Mijn gedachten gaan naar 2 opties, maar van beide weet ik niet precies hoe ik dat moet doen of dat het mogelijk is;
1) De gegevens opvragen dmv van een userform aanvullen en weer weg schrijven? Helaas weet ik niet precies hoe ik dit bewerkstellig dat de juiste regel word aangepast me wegschrijven.
2) is er nog een optie in het draaitabel die ik over het hoofd heb gezien waarbij ik gegevens aan de regel kan van het draaitabel kan aanvullen?

In de bijlage heb ik een voorbeeld je toegevoegd.

 

[JEC.]

Maak een tabel van de masterdata -> Format as table.

Vervolgens pas je de range aan van je draaitabel. Verwijs hier naar de range van je 'Table'
Je kunt daarna rechtermuisknop op de draaitabel om te refreshen.

OF: rechtermuisknop , draaitabel opties, data, automatisch refreshen aanvinken.

 

[VenA]

Je kan inderdaad het beste een echte tabel van jouw 'database' maken. Je zal dan waarschijnlijk wel de code van jouw formulier moeten aanpassen wat sowieso geen slecht idee is.

Het automatisch refreshen aanvinken werkt alleen als je het bestand opnieuw opent. Met in macro in de module van het blad 'Draaitabel' kan het wel automatisch.
Bv zo

Private Sub Worksheet_Activate()
  ThisWorkbook.RefreshAll
End Sub

 

[wekkanz]

Dankje wel! dat werkt!, ik heb nog even wat werk te doen maar het werkt snel en overzichtelijk.

Hartelijk dank voor het mee denken!

 

[wekkanz]

Een laatste vraag, Als ik aan mijn tabel een extra regel toevoeg, word deze niet automatisch mee genomen in de range van mijn draaitabel.
Is het mogelijk om de range automatisch mee te nemen? Anders moet ik telkens handmatig de range aanpassen.

 

[VenA]

Zie #7 en #10

 

[wekkanz]

Dankje wel VenA ik heb zie dat ik met het tabel formatteren iets niet goed had gedaan, is nu op gelost!
Hartelijk dank voor je ondersteuning!