uitbreiden van de kopieercode in een jaarplanning

[Tae]

Beste,

In mijn jaarplanning welke met behulp van dit forum is gemaakt, zou ik graag een kleine aanvulling willen.

Door in cel B2 in de tab “week selectie” een weeknummer in te voeren of te selecteren worden de betreffende klanten vanuit de tab “planning” in een overzicht in kolom B geplaatst.
Graag zou ik aangevuld zien dat de uitvoering welke bij de klant en week hoort (staat vermeld in de planning) ook mee gekopieerd wordt en achter hun naam komt te staan (Kolom C)

Is dit mogelijk vraag ik mij af.

Vriendelijke groet,
Tae

 

[HSV]

Om in je eigen code te blijven.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sn, sp, c As Range, c00 As String, firstaddress As String
If Target.Address = "$B$2" Then
Application.EnableEvents = False
With Sheets("planning")
sn = .UsedRange
 Set c = .UsedRange.Find(Target, , xlValues, xlWhole)
    If Not c Is Nothing Then
      firstaddress = c.Address
      Do
       If c.Column > 2 Then
         c00 = c00 & sn(c.Row, 1) & vbLf
[COLOR=#0000FF]         s00 = s00 & c.Offset(, 1) & vbLf[/COLOR]
       End If
     Set c = .UsedRange.FindNext(c)
 Loop While Not c Is Nothing And c.Address <> firstaddress
End If
    With Cells(9, 2)
    .CurrentRegion.ClearContents
      If c00 <> "" Then
           sp = Split(c00, vbLf)
[COLOR=#0000FF]           sq = Split(s00, vbLf)[/COLOR]
          .Resize(UBound(sp)) = Application.Transpose(sp)
[COLOR=#0000FF]          .Offset(, 1).Resize(UBound(sp)) = Application.Transpose(sq)[/COLOR]
        Else
          .Value = "geen gegevens"
      End If
    End With
  Application.EnableEvents = True
 End With
 End If
End Sub

Maar je kan het ook zo schrijven.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Application.EnableEvents = False
n = 1
sn = Sheets("planning").UsedRange
 sq = sn
 For i = 5 To UBound(sn)
  For j = 3 To UBound(sn, 2)
    If sn(i, j) = Target.Value Then
     sq(n, 1) = sn(i, 1)
     sq(n, 2) = sn(i, j + 1)
     n = n + 1
    End If
   Next j
  Next i
With Cells(9, 2)
 .CurrentRegion.ClearContents
   If n > 1 Then
      .Resize(n - 1, 2) = sq
    Else
     .Resize(, 2) = "geen gegevens"
    End If
End With
Application.EnableEvents = True
End If
End Sub

 

[Tae]

Daar wordt ik dan even stil van. Mooi om naar een ander zijn vakwerk te kijken.

Harry bedankt.