VBA automatisch cellen doorverwijzen naar specifieke tabblad

Status
Niet open voor verdere reacties.
O

ozzyozzy

Gebruiker
Lid geworden
3 jul 2009
Berichten
126
Hoi allemaal,

Kan iemand mij helpen met een vba codering. Ik kwam er niet uit. Wat mijn wens is dat de tabblad “Namen Medewerkers” met range A5:p10 automatisch naar tabblad “Planning 1”, “Planning 2”, “Planning 3” doorverwijst bij wijzigingen in tabblad “Namen Medewerkers”. De kleuren ook automatisch doorverwijzen naar “Planning 1”, “Planning 2”, “Planning 3”.
Er is ook een filter bij deze “Planning 1”, “Planning 2”, “Planning 3”. Is hier een mogelijkheid en of oplossing er in? Graag ontvang ik uw reacties? En mogelijke coderingen.
bijlage is mij niet gelukt om erop te zetten.

Bedankt.
 
nu bijlage mee verzonden
 

Bijlagen

  • namen test1s.xlsx
    12,1 KB · Weergaven: 25
En je gaat er nu vanuit dat wij jouw gedachtegang kunnen volgen? In een xlsx staat geen code dus daar is ook niets uit op te maken. Gebruik geen samengevoegde cellen. Zorg voor structuur in de werkbladen. Cel A1 is niet voor niets uitgevonden.

Geef duidelijk aan wat je wil want ik begrijp er niet veel van.
 
Code: 
[CODE]Dat klopt is weg gevallen en of ander manier krijg ik het niet mee verzonden. maar de code is als volgt. 
moet afzonderlijk zijn Namen Medewerkers gekoppeld aan Planning 1 Planning 2 en Planning 3. 

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim WB As Worksheet
    If Not Intersect(Target, Range("A6:P10")) Is Nothing Then
        For Each WB In ActiveWorkbook.Worksheets
            Worksheets("Planning 1").Value = ActiveSheet.Range("A6:P10").Value
        Next
    
    End If

Dim WB As Worksheet
    If Not Intersect(Target, Range("A6:P10")) Is Nothing Then
        For Each WB In ActiveWorkbook.Worksheets
            Worksheets("Planning 2").Value = ActiveSheet.Range("A6:P10").Value
        Next
    
    End If

Dim WB As Worksheet
    If Not Intersect(Target, Range("A6:P10")) Is Nothing Then
        For Each WB In ActiveWorkbook.Worksheets
            Worksheets("Planning 3").Value = ActiveSheet.Range("A6:P10").Value
        Next
    
    End If


Dim WB As Worksheet
    If Not Intersect(Target, Range("A6:P10")) Is Nothing Then
        For Each WB In ActiveWorkbook.Worksheets
            Worksheets("Namen Medewerkers").Value = ActiveSheet.Range("A6:P10").Value
        Next
    
    End If

Option Explicit
Public Function CELKLEUR(ByRef cel As Range) As Variant
    Application.Volatile True
    CELKLEUR = cel.Interior.ColorIndex
If Not Intersect(Target, Range("A6:D10")) Is Nothing Then[CODE]
For Each WB In ActiveWorkbook.Worksheets
WB.Range("A6:D10").Value = ActiveSheet.Range("A6:D10").Value
Next
End Function[/CODE]
 
Laatst bewerkt:
werkt wel op Thisworkbook, maar neemt alle tabbladen mee

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim WB As Worksheet
If Not Intersect(Target, Range(""A6:D10"")) Is Nothing Then
For Each WB In ActiveWorkbook.Worksheets
WB.Range(""A6:D10"").Value = ActiveSheet.Range(""A6:D10"").Value
Next

End If
End Sub

Option Explicit
Public Function CELKLEUR(ByRef cel As Range) As Variant
Application.Volatile True
CELKLEUR = cel.Interior.ColorIndex
If Not Intersect(Target, Range("A6:D10")) Is Nothing Then
For Each WB In ActiveWorkbook.Worksheets
WB.Range("A6:D10").Value = ActiveSheet.Range("A6:D10").Value
Next
End Function
 
Geef duidelijk aan wat je wil want ik begrijp er niet veel van.
Klik om te vergroten...
Geen reactie op gezien. De manier van reageren maakt het er niet veel duidelijker op.
 
Beste zie bijlage ik wil zoiets maken.

Als er wijziging bij tabblad "Namen Medewerkers" ingevoerd wordt, dat die dan automatisch overneemt naar tabblad planning 1, 2 en 3
incl. kleur op Cel. A1
 

Bijlagen

  • namen test1.xlsm
    47,4 KB · Weergaven: 30
Ik heb hmm al wat ik wou. met Macro Button werkt prima.

Code: 
Sub Paste_Other_Sheet_or_Book()
 
    'Cut or Copy and Paste to another worksheet
    Worksheets("Namen Medewerkers").Range("A6:P30").Copy Worksheets("Planning 1").Range("A6:P30") 'Copy
    Worksheets("Namen Medewerkers").Range("A6:P30").Copy Worksheets("Planning 2").Range("A6:P30") 'Copy
    Worksheets("Namen Medewerkers").Range("A6:P30").Copy Worksheets("Planning 3").Range("A6:P30") 'Copy
    Application.CutCopyMode = False
End Sub
 
Laatst bewerkt:
Gebruik bij voorkeur geen samengevoegde cellen en zeker niet in combinatie met VBA. Wat je nu wil bereiken is nog steeds niet duidelijk. De code in #8 kan je reduceren tot

Code: 
Sub VenA()
  For j = 1 To 3
    Sheets("Namen Medewerkers").Cells(5, 1).CurrentRegion.Resize(, 16).Copy Sheets("Planning " & j).Cells(5, 1)
  Next j
End Sub
 
Oneliner:
Code: 
Sub hsv()
 Sheets(Array("namen medewerkers", "planning 1", "planning 2", "planning 3")).FillAcrossSheets Sheets("namen medewerkers").Range("a5:p30")
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan