VBA Hilfe linke Taste aktiv

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
ich gehe mal davon aus, dass nur jeweils innerhalb des Bereiches "verschoben" werden soll.
Folgender Code in das Modul "DieseArbeitsmappe", er wird aktiv, wenn 1 Zelle im Bereich ausgewählt wird!

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private varValues As Variant

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

On Error GoTo Errorhandler
If Target.Count > 1 Then Exit Sub

Application.EnableEvents = False

If Not Intersect(Target, Range("D9:I209")) Is Nothing Then
  If IsArray(varValues) Then
    If UBound(varValues, 2) = 6 Then
      Range(Cells(Target(1, 1).Row, 4), Cells(Target(1, 1).Row, 9)) = varValues
      varValues = ""
    End If
  Else
    If Application.CountA(Range(Cells(Target(1, 1).Row, 4), Cells(Target(1, 1).Row, 9))) > 0 Then
      varValues = Range(Cells(Target(1, 1).Row, 4), Cells(Target(1, 1).Row, 9))
    End If
  End If
ElseIf Not Intersect(Target, Range("M9:T209")) Is Nothing Then
  If IsArray(varValues) Then
    If UBound(varValues, 2) = 8 Then
      Range(Cells(Target(1, 1).Row, 13), Cells(Target(1, 1).Row, 20)) = varValues
      varValues = ""
    End If
  Else
    If Application.CountA(Range(Cells(Target(1, 1).Row, 13), Cells(Target(1, 1).Row, 20))) > 0 Then
      varValues = Range(Cells(Target(1, 1).Row, 13), Cells(Target(1, 1).Row, 20))
    End If
  End If
Else
  varValues = ""
End If

Errorhandler:
Application.EnableEvents = True
End Sub

Gruß Sepp

' ********************************************************************** ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private varValues As Variant Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) On Error GoTo Errorhandler If Target.Count > 1 Then Exit Sub Application.EnableEvents = False If Not Intersect(Target, Range("M3:M209, Q3:Q209")) Is Nothing Then If Target <> "" And Not Target Like "Gruppe*" Then varValues = Target.Value Else varValues = "" End If ElseIf Not Intersect(Target, Range("D2:I209")) Is Nothing Then If varValues <> "" Then Target = varValues varValues = "" End If End If Errorhandler: Application.EnableEvents = True End Sub

' ********************************************************************** ' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private varValues As Variant Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) On Error GoTo Errorhandler Select Case Sh.Name Case "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag" If Target.Count > 1 Then Exit Sub Application.EnableEvents = False If Not Intersect(Target, Range("M3:M209, Q3:Q209")) Is Nothing Then If Target <> "" And Not Target Like "Gruppe*" Then varValues = Target.Value Else varValues = "" End If ElseIf Not Intersect(Target, Range("D2:I209")) Is Nothing Then If varValues <> "" Then Target = varValues varValues = "" End If End If Case Else End Select Errorhandler: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread