Clever-Excel-Forum

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

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

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

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

Kuwer darf man dir mal ne PN schreiben ?

BrianMolko1980

Kuwer

BrianMolko1980

Kuwer

BrianMolko1980