Office 2007: Makro zum einordnen von Zeilen bei bestimmten Wert in neue Tabelle

[Nusserdt]

Hallo liebes Forum,

ich habe ein Problem bei meiner Kunden-Termin-Liste, mit der ich arbeite, das die Essenz dieser Liste erheblich beeinträchtigt.

Ich habe bereits von einem Freund die Anfänge eines Makros erhalten, Aufgrund seiner Excel 2000 Version kann mir jedoch nicht mehr weiterhelfen.

Es soll ein Makro die Kunden in Abhängigkeit ob ihr Termin wahrgenommen wurde oder nicht in die jeweilig dafür vorgesehene Arbeitsblatt einordnen (Wahrgenommen = ja; nicht Wahrgenommen = nein).
Das Makro erkennt die (ab 2007) eingeführten Tabellen-Matrixen nicht als erste freie Zelle und setzt den kopierten Zeileneintrag stets unter die bereits vorgefertigten Tabellen auf den anderen Arbeitsblättern.

Zunächst erst einmal das Makro:

Code: [Auswählen]

Sub test2()
   Dim lngI              As Long
   Dim ws1               As Worksheet
   Dim ws2               As Worksheet
   Dim ws3               As Worksheet

   Set ws1 = Worksheets("Telefonliste")
   Set ws2 = Worksheets("Wahrgenommene Termine")
   Set ws3 = Worksheets("Nicht gekommene Termine")

   'Durch das "Cut" in Zeile E wird das Worksheet_Change ausgelöst.
   'um das zu verhindern:
   Application.EnableEvents = False
   On Error GoTo fixit

   For lngI = 8 To ws1.Range("I65536").End(xlUp).Row

      If ws1.Cells(lngI, 9).Value = "ja" Then
         ws1.Range(ws1.Cells(lngI, 2), ws1.Cells(lngI, 13)).Copy _
               ws2.Cells(ws2.Range("B65536").End(xlUp).Row + 1, 2)
ws1.Range(ws1.Cells(lngI, 2), ws1.Cells(lngI, 13)).ClearContents

      ElseIf ws1.Cells(lngI, 9).Value = "nein" Then
         ws1.Range(ws1.Cells(lngI, 2), ws1.Cells(lngI, 13)).Copy _
               ws3.Cells(ws3.Range("B65536").End(xlUp).Row + 1, 2)
        ws1.Range(ws1.Cells(lngI, 2), ws1.Cells(lngI, 13)).ClearContents
      End If

   Next lngI
   'Die bedingten Formatierungen aus der Telefonliste werden mit übertragen
   'Hier werden alle Bed. Formatierungen in ws2 und ws3 gelöscht:
   With ws2
   .Select
       .Cells.FormatConditions.Delete
      .Range(.Range("E8"), .Range("E" & Rows.Count).End(xlUp)).Select
      Selection.Validation.Delete
   End With
   With ws3
   .Select
      .Cells.FormatConditions.Delete
      .Range(.Range("E8"), .Range("E" & Rows.Count).End(xlUp)).Select
      Selection.Validation.Delete
   End With
   
ws1.Select
fixit:
   Application.EnableEvents = True
End Sub

Es befindet sich in Modul2 in dieser .xlsm

http://www.file-upload.net/download-8100298/Telefonliste-zum-Versenden.xlsm.html

Voraussetzung:

-Das Makro darf nicht die (bed.) Formatierung auf der Hauptliste entfernen oder zerstören
-die Formatierungen auf den Arbeitsblättern sind weitgehend identisch
-Non-Plus-Ultra wäre natürlich wenn das Makro nachdem der Eintrag aus der entsprechende kopierten Zeile entfernt wurde, die Liste wieder hochrückt, damit keine Leer-Zeilen entstehen

Ich bin für jede Hilfe dankbar.

Liebe Grüße, Martin

[Nusserdt]

Hallo liebes Forum,

hat Niemand einen Rat?

Vermutlich muss das Makro nur von Excel 2000 auf Excel 2007+ angepasst werden.

Leider kenne ich mich nicht genug in VBA aus das ich das selbst erledigen könnte.

Ich bin für jede Hilfe dankbar.

Liebe Grüße, Nusserdt.