Thema Datum  Von Nutzer Rating
Antwort
24.05.2016 10:16:15 Elchbraten
NotSolved
24.05.2016 16:21:43 Gast45408
NotSolved
25.05.2016 19:14:48 Elchbraten
NotSolved
25.05.2016 19:49:05 Gast32752
NotSolved
Rot In anderes Tabellenblatt verschieben
 26.05.2016 11:40:25 Gast70117
NotSolved
28.05.2016 12:31:55 Elchbraten
Solved

Ansicht des Beitrags:
Von:
Gast70117		 Datum:
26.05.2016 11:40:25		 Views:
897		 Rating:
     
Antwort:
  Ja
Thema:
In anderes Tabellenblatt verschieben

Nun ich meine, wenn sich schon jemand als absolut VBA unkundig vorstellt, dann wird der

Hilfesuchende wohl kaum die Praxis für einen halbwegs funktionierenden Algorithmus, einen

Programmlaufplan ausweisen. Womit wohlmeinende Hinweise auf diverse Excel Ereignisse

oder Methoden, zumal im Web zusammengekratzt ersteres sicher nicht ersetzen.

 

Sei es darum, wenn schon denn schon. Wobei mein Vorschlag exakt auf den Tabellenaufbau

des Bildes aufbaut.

Nächste Voraussetzung, der Fragesteller kann zumindest die Klassen-Code-Module der Tabellen

durch Doppelklick in den Tabellenbaum öffnen, bzw. ein einfaches Codemodul anlegen.

 

Gegenständlich bekommt jede Tabellenklasse diesen, den gleichen Code

?
1
2
3
4
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Count = 1 And Target.Row > 1 Then _
      If Not Intersect(Columns(cCOLS), Target) Is Nothing Then DoIt Target
End Sub

und dazu in ein einfaches Codemodul

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit
 
Public Const cCOLS As String = "F:G"
'Zelle F1 bzw. G1 sind die bezogenen Tabellennamen
 
Sub DoIt(myRng As Range)
Dim strName As String
 
'sinnlos
If Application.CountA(myRng.EntireRow) <= 1 Then Exit Sub
 
On Error GoTo errorhandler
Application.EnableEvents = False
 
   strName = ActiveSheet.Columns(myRng.Column).Cells(1).Value
    
   Select Case myRng.Parent.Name
      Case "Aktiv"
         'eine Richtung - nur markieren
         If Not IsEmpty(myRng) Then
            myRng.EntireRow.Copy _
            Sheets(strName).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            myRng.EntireRow.Delete
         End If
       
      Case "Erledigt"
         If strName = ActiveSheet.Name Then
            If Not IsEmpty(myRng) Then
               'nicht gelöscht
            Else
               Columns(cCOLS).Rows(myRng.Row).ClearContents
               myRng.EntireRow.Copy _
               Sheets("Aktiv").Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            End If
         Else
            If Not IsEmpty(myRng) Then
               myRng.Offset(, -1).ClearContents
               myRng.EntireRow.Copy _
               Sheets(strName).Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            Else
               'nicht markiert
            End If
         End If
          
      Case "Archiv"
         If strName = ActiveSheet.Name Then
            If Not IsEmpty(myRng) Then
               'nicht gelöscht
            Else
               Columns(cCOLS).Rows(myRng.Row).ClearContents
               myRng.EntireRow.Copy _
               Sheets("Aktiv").Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            End If
         Else
            If Not IsEmpty(myRng) Then
               myRng.Offset(, 1).ClearContents
               myRng.EntireRow.Copy _
               Sheets(strName).Cells(Rows.Count, 1).End(xlUp).Offset(1)
               myRng.EntireRow.Delete
            Else
               'nicht markiert
            End If
         End If
          
   End Select
    
On Error GoTo 0
errorhandler:
Application.EnableEvents = True
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
24.05.2016 10:16:15 Elchbraten
NotSolved
24.05.2016 16:21:43 Gast45408
NotSolved
25.05.2016 19:14:48 Elchbraten
NotSolved
25.05.2016 19:49:05 Gast32752
NotSolved
Rot In anderes Tabellenblatt verschieben
 26.05.2016 11:40:25 Gast70117
NotSolved
28.05.2016 12:31:55 Elchbraten
Solved