Kopiermakro erweitern auf 2. Tabellenblatt

[BrianMolko1980]

Hallo 

ich habe dieses Kopiermakro von euch bekommen und frage heute ob man dieses noch erweitern kann auf ein zweites Tabellenblatt was den namen Taktzeit besitzt.

Gruß Ron und vorab schon mal Danke


Option Explicit
'
'Sobald sich im Arbeitsblatt "Rotationsplan" bei der Zell(bereis)auswahl "Target" eine Änderung ergibt,
'wird folgende SUB ausgeführt:
'
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

  'Nur wenn es sich um Arbeitsblatt "Rotationsplan" handelt, das Folgende ausführen:
If Sh.Name <> "Rotationsplan" Then Exit Sub
  'Es wird überprüft, ob die Zell(bereichs)auswahl "Target" sich mit dem Spaltenbereich "Q"
  'überschneidet (also bereide Bereiche mindestens 1 gemeinsame Zelle besitzen):
  If Not Intersect(Target, Sh.Columns("Q")) Is Nothing Then
    'Kopiere Zelle(n) in die Zwischenablage
      Target.Copy
    'Application-Objekt befindet sich jetzt im Kopiermodus (xlCopy)
  Else
    '"Target" hat keine gemeinsame Zelle mit Spalte "Q"
      If Not Target Is Nothing Then
        'Da "Target" Zellen besitzt (kein leerer Bereich),
        'wird überprüft, ob das Application-Objekt sich (bereits) im Kopiermodus befindet:
        If Application.CutCopyMode = xlCopy Then
          'Application-Objekt befindet sich im Kopiermodus,
          'daher füge den Inhalt der Zwischenablage in "Target" ein:
            Target.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
          'Falls nur Zellwerte (ohne jede Formatierung...) eingefügt werden sollen,
          'statt "Sh.Paste" die folgende Anweisung nehmen:
          'Target.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        End If
        'Kopiermodus des Application-Objektes ausschalten,
        'um den Einfügemodus abzuschalten:
        Application.CutCopyMode = False
      End If
  End If
 
End Sub

[Kuwer]

Hallo Ron,

Code:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Select Case Sh.Name
    'Nur wenn es sich um Arbeitsblatt "Rotationsplan" oder "Taktzeit" handelt, das Folgende ausführen:
    Case "Rotationsplan", "Taktzeit"
      'Es wird überprüft, ob die Zell(bereichs)auswahl "Target" sich mit dem Spaltenbereich "Q"
      'überschneidet (also bereide Bereiche mindestens 1 gemeinsame Zelle besitzen):
      If Not Intersect(Target, Sh.Columns("Q")) Is Nothing Then
        'Kopiere Zelle(n) in die Zwischenablage
          Target.Copy
        'Application-Objekt befindet sich jetzt im Kopiermodus (xlCopy)
      Else
        '"Target" hat keine gemeinsame Zelle mit Spalte "Q"
        If Not Target Is Nothing Then
          'Da "Target" Zellen besitzt (kein leerer Bereich),
          'wird überprüft, ob das Application-Objekt sich (bereits) im Kopiermodus befindet:
          If Application.CutCopyMode = xlCopy Then
            'Application-Objekt befindet sich im Kopiermodus,
            'daher füge den Inhalt der Zwischenablage in "Target" ein:
              Target.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
            'Falls nur Zellwerte (ohne jede Formatierung...) eingefügt werden sollen,
            'statt "Sh.Paste" die folgende Anweisung nehmen:
            'Target.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
          End If
          'Kopiermodus des Application-Objektes ausschalten,
          'um den Einfügemodus abzuschalten:
          Application.CutCopyMode = False
        End If
      End If
  End Select
End Sub

Gruß Uwe

[BrianMolko1980]

und auf dem 2. Blatt andere Spalten auswählen, funktioniert denke ich wenn ich richtig dahinter gestiegen bin nicht ?


in Rotationsplan müßten die Zellen aus Spalte Q

in Taktzeit die Zellen von Spalte L M N O
kopiert werden.

dann wäre es perfekt aber Danke schon mal für diese Info

[Kuwer]

Hallo Ron,

Code:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rngSpalten As Range
  Select Case Sh.Name
    'Nur wenn es sich um Arbeitsblatt "Rotationsplan" oder "Taktzeit" handelt, das Folgende ausführen:
    Case "Rotationsplan"
      Set rngSpalten = Sh.Columns("Q")
    Case "Taktzeit"
      Set rngSpalten = Sh.Columns("L:O")
  End Select
  If Not rngSpalten Is Nothing Then
    'Es wird überprüft, ob die Zell(bereichs)auswahl "Target" sich mit dem Spaltenbereich "Q"
    'überschneidet (also bereide Bereiche mindestens 1 gemeinsame Zelle besitzen):
    If Not Intersect(Target, rngSpalten) Is Nothing Then
      'Kopiere Zelle(n) in die Zwischenablage
        Target.Copy
      'Application-Objekt befindet sich jetzt im Kopiermodus (xlCopy)
    Else
      '"Target" hat keine gemeinsame Zelle mit Spalte "Q"
      If Not Target Is Nothing Then
        'Da "Target" Zellen besitzt (kein leerer Bereich),
        'wird überprüft, ob das Application-Objekt sich (bereits) im Kopiermodus befindet:
        If Application.CutCopyMode = xlCopy Then
          'Application-Objekt befindet sich im Kopiermodus,
          'daher füge den Inhalt der Zwischenablage in "Target" ein:
            Target.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
          'Falls nur Zellwerte (ohne jede Formatierung...) eingefügt werden sollen,
          'statt "Sh.Paste" die folgende Anweisung nehmen:
          'Target.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        End If
        'Kopiermodus des Application-Objektes ausschalten,
        'um den Einfügemodus abzuschalten:
        Application.CutCopyMode = False
      End If
    End If
  End If
End Sub

Gruß Uwe

[BrianMolko1980]

Kuwer darf man dir mal ne PN schreiben ?