VBA code aanpassen lijst naar 2 werkbladen kopieren

[bigfoot47]

Hoi,

Ik heb een vba code die als er in een cel een (X) staat plaast hij deze naar een werkmap. Hoe kan ik deze dat ook nog op een ander werkmap doen plaatsen?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, bBeide As Boolean
    'festivaldagen
    If Not Intersect(Target, Columns(12)) Is Nothing Then  
        Select Case Target.Value                                
        Case "x": Sheets("Festival dag 3").Cells(Rows.Count, 1).End(xlUp).Offset(1) = Target.Offset(, -11): GoTo DelVast 
        Case "o": Sheets("Blad4").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2).Value = Array(Target.Offset(, -11), Target.Offset(, 1)): GoTo DelRot 
        Case Else: bBeide = True: GoTo DelVast                 
        End Select
DelVast:
        Set c = Sheets("Blad4").Columns(1).Find(Target.Offset(, -11), , xlValues, xlWhole)   
        If Not c Is Nothing Then
            c.Resize(, 2).Delete shift:=xlUp    
        End If
        If Not bBeide Then Exit Sub
DelRot:
        Set c = Sheets("Festival dag 3").Columns(1).Find(Target.Offset(, -11), , xlValues, xlWhole)
        If Not c Is Nothing Then
            c.Delete shift:=xlUp
        End If
    End If

Heb de code nog maals er onder geplaatst.
Ik had de code een aangepast naar delvast 1 en delrot 1 en de map festival dag 3 ook aangepast naar het ander werkblad. zo als hier onder maar werk niet. Wat moet ik doen?

    'festivaldagen
    If Not Intersect(Target, Columns(12)) Is Nothing Then  
        Select Case Target.Value                                
        Case "x": Sheets("Walky dag 3").Cells(Rows.Count, 1).End(xlUp).Offset(1) = Target.Offset(, -11): GoTo DelVast1  
        Case "o": Sheets("Blad4").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2).Value = Array(Target.Offset(, -11), Target.Offset(, 1)): GoTo DelRot1  
        Case Else: bBeide1 = True: GoTo DelVast1                 
        End Select
DelVast:
        Set c1 = Sheets("Blad4").Columns(1).Find(Target.Offset(, -11), , xlValues, xlWhole)   
        If Not c1 Is Nothing Then
            c1.Resize(, 2).Delete shift:=xlUp    
        End If
        If Not bBeide Then Exit Sub
DelRot:
        Set c1 = Sheets("Walky dag 3").Columns(1).Find(Target.Offset(, -11), , xlValues, xlWhole)
        If Not c1 Is Nothing Then
            c1.Delete shift:=xlUp
        End If
    End If

mvg Bigfoot

 

[sylvester-ponte]

excelbestandje?

 

[VenA]

In je tweede code roep je DelVast1 en DelRot1 aan. Maar deze bestaan niet.

 

[bigfoot47]

VenA ik heb een fout hier boven geplaatst maar deze staat werkelijk op delvast 1 en delrot 1 aan de linkse kant.

 

[VenA]

Vandaar ook het verzoek van sylvester-ponte. Als we rekening moet gaan houden met jouw verkeerd geplaatste code en daar nog een oplossing voor mogen verzinnen, dan mag je zelf het resultaat invullen.

 

[bigfoot47]

Beste net thuis op de pc waar de Excel bestandje op staat en kan ik nu deze er bij voegen. Maar het lukt niet een .xlsm bestand mag niet groter zijn dan 100kb.
Ik heb nog na paar dingen weg gedaan en toen nog 160kb.

Hoe kan ik het wel hier plaatsen ?

Mvg

 

[HSV]

Misschien dat opslaan als .xlsb enig soelaas bied.

 

[bigfoot47]

Heb gedaan wat HSV heeft gezegd dus je moet de .xlsb terug in .xlsm veranderen anders lukte het niet.

Bekijk bijlage lijst1.xlsb

mvg Bigfoot

 

[VenA]

Volgens mij heb je niet gedaan wat HSV geschreven heeft. Het bestandje is nl niet te openen. Je hebt de extensie aangepast en dat is wat anders dan een bestand opslaan als.

Kom svp eerst met goede uitleg wat je wil en plaats een bestandje dat direct te openen is. Het gaat om een soort projectplanning? Maar wat je wil kan ik er niet uit opmaken. Als je de achtergrond eruit haalt wordt het bestand waarschijnlijk ook al een stuk kleiner.

 

[bigfoot47]

Als ik in pagina medewerker een kruisje zet in cel j4, komt de naam staan in werkmap festival dag 1 maar hoe kan ik nu ook die naam in cel a3 van de werkmap walky dag 1 krijgen.

 

[VenA]

Persoonlijk vind ik de opzet niet handig. Maak één tabel waarin je alles vastlegt.

Maar goed, met deze code worden de andere drie tabje voorzien van de namen waar een x in kolom j staat.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns(10)) Is Nothing Then
        Application.EnableEvents = False
        ar = Range("A4", Range("A4").End(xlDown)).Resize(, 10)
        For j = 1 To UBound(ar)
            If LCase(ar(j, 10)) = "x" Then
                c00 = c00 & ar(j, 1) & "|"
                t = t + 1
            End If
        Next j
        If t > 0 Then
            For Each sh In Sheets(Array("Festival dag 1", "Walky dag 1", "Blad4"))
                With sh.Cells(3, 1)
                    .Resize(UBound(ar)).ClearContents
                    .Resize(t, 1) = Application.Transpose(Split(c00, "|"))
                End With
            Next sh
        End If
        Application.EnableEvents = True
    End If
End Sub

 

[bigfoot47]

Bedankt