|  
                                             
	Hallo zusammen, 
	  
	habe bereits einiges realisieren können. Jedoch besteht leider immer noch ein Problem, welches ich nicht zu Lösen vermag. 
	  
	Ich möchte die Tickets, welche erledigt wurden, das heißt nach aktualisieren nicht mehr in der Datenbank vorhanden sind, in einen extra Reiter kopieren lassen. Kann mir jemand dabei helfen? 
'Refresh-Button
Function Schaltfläche1_Klicken()
Call FilterZurücksetzenMaster
Call Ticketuebersicht
Call SpaltenFormatierung
Call Referenzen
Call SortierenTicketId
End Function
'eingestellte Filter werden hier wieder zurückgesetzt
Function FilterZurücksetzenMaster()
 Dim intI As Integer
 
 With Worksheets("Masteransicht")
     For intI = 1 To 12  '"1 To 12" entspricht den Spalten A bis L
      Selection.AutoFilter Field:=intI
     Next
 End With
 
 End Function
Function Ticketuebersicht()
    'Löschen der alte Tabelle
    Range("A1:Z999").Clear
    
    'auf ServiceCenter zugreifen und neue Tabelle erzeugen
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;
        , Destination:=Range("A8"))
        .Name = "Tasklist.asp?Taskstatus=2%2C10%2C12%2C9%2C40%2C7%2C22%2C30&sys_allmyroles=1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
              
    End With
    
End Function
Function SpaltenFormatierung()
    'Löschen der Spalten A und B da unnötig, und verschieben der restliche Spalten nach links
    Range("A:B").Delete
    
    'Löschung der Spalte "Re? Gruppieren"
    'Range("B:B").Delete
    
    'Definiern der Spaltenbreite der Spaltenüberschriften
    Columns("A:A").ColumnWidth = 21
    Range("A:A").HorizontalAlignment = xlCenter
    Columns("B:M").AutoFit
    
    'Formatierung der Spaltenüberschriften
    With Range("A12.M12")
                    .Font.Bold = True
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Interior.ColorIndex = 37
                    .BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
                    .AutoFilter
    End With
End Function
    
'Sortieren nach Ticket ID aufsteigend
Function SortierenTicketId()
    Sheets("Masteransicht").Range("A12:M500").Sort Key1:=Range("A12"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
'Aufrufinformationen
Function Referenzen()
Range("C2") = "Datum"
Range("C2").Font.Bold = True
Range("D2") = Date
Range("C2:D2").BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
Range("D2").HorizontalAlignment = xlLeft
Range("C3") = "Uhrzeit"
Range("C3").Font.Bold = True
Range("C3:D3").BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
Range("D3") = Time
Range("D3").HorizontalAlignment = xlLeft
Range("C4") = "User"
Range("C4").Font.Bold = True
Range("D4") = Environ("Username")
Range("C4:D4").BorderAround LineStyle:=xlContinuous, ColorIndex:=xlAutomatic
Range("C5") = "URL"
Range("C5").Font.Bold = True
Range("D5") = "
End Function
'Button übernimmt Änderungen aus Masteransicht
Function Schaltfläche5_Klicken()
Call SortierenTicketIdAufsteigend
Call NeueTickets
Call DoppelteEinträgeLöschen
Call SortierenTicketIdAbsteigend
Call Formatierungen
Call Schaltfläche4_Klicken
End Function
'sortiert nach "Anfragen ID" aufsteigend
Function SortierenTicketIdAufsteigend()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
 'fügt neu ankommende Tickets hinzu
 Function NeueTickets()
 i = 13 'erste Zelle mit Inhalt in "Masteransicht"
 k = 7  'erste Zeile "Tickets priorisieren" in der Inhalt aus "Masteransicht" kopiert werden soll
'Ticket IDs werden Zeile für Zeile auf Gleichheit geprüft, wenn ungleich neue Zeile in "Tickets priorisieren" einfügen
 For Each zel In Sheets("Masteransicht").Range("A13.A500")
    If Sheets("Masteransicht").Cells(i, 1).Value = Sheets("Tickets priorisieren").Cells(k, 6).Value Then
    
    i = i + 1
    k = k + 1
    
    Else
    
    letzteZeile = Sheets("Tickets priorisieren").Cells(Rows.Count, 6).End(xlUp).Row
    
    Sheets("Tickets priorisieren").Range("F" & letzteZeile + 1).Resize(1, 13) = _
    Sheets("Masteransicht").Range("A" & zel.Row).Resize(1, 13).Value
    
    i = i + 1
    k = k + 1
    
    letzteZeile = letzteZeile + 1
    End If
Next
End Function
'Löscht doppelte Einträge
 Function DoppelteEinträgeLöschen()
 Dim lngZeile As Long
 Dim lngZeilenSprung As Long
 Dim strSuchwert As String
 lngZeile = Cells(Rows.Count, 6).End(xlUp).Row
   
   For lngZeilenSprung = lngZeile To 7 Step -1
     strSuchwert = Cells(lngZeilenSprung, 6).Value
       If Application.WorksheetFunction.CountIf(Range(Cells(6, 6), Cells(lngZeile, 6)), strSuchwert) <> 1 Then
         Cells(lngZeilenSprung, 6).Resize(1, 13).Select
         Selection.Delete
       End If
   Next lngZeilenSprung
 End Function
 
'Tickets werden entsprechend ihrer Id absteigend sortiert->neue Tickets erscheinen oben
Function SortierenTicketIdAbsteigend()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("F6"), Order1:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
 
 'Spalten A,B,F,I und N werden zentriert, bei Spalten F bis R wird Spaltenbreite automatisch festgelegt
 Function Formatierungen()
 
    Sheets("Tickets priorisieren").Range("A:B, F:F, I:I, N:N").HorizontalAlignment = xlCenter
    Sheets("Tickets priorisieren").Columns("F:R").AutoFit
 
 End Function
 
 'wird über "Schaltfläche5_Klicken" aufgerufen
 Function Schaltfläche4_Klicken()
 Call SortierenTicketIdAufsteigend2
 Call LöschenGeschlosseneTickets
 Call SortierenTicketIdAbsteigend2
 End Function
Function SortierenTicketIdAufsteigend2()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
 
 'Löscht bereits geschlossene Tickets aus Tabelle "Tickets priorisieren"
Function LöschenGeschlosseneTickets()
 i = 13
 k = 7
 
 'Ticket IDs werden Zeile für Zeile auf Gleichheit geprüft, wenn ungleich wird Zeile markiert und gelöscht
 For Each zel In Sheets("Tickets priorisieren").Range("A7:A500")
    If Sheets("Tickets priorisieren").Cells(k, 6).Value = Sheets("Masteransicht").Cells(i, 1).Value Then
    k = k + 1
    i = i + 1
    
    Else
    Sheets("Tickets priorisieren").Cells(k, 1).Resize(1, 18).Select '"1,18" entspricht den Spalten A bis M
    Selection.Delete
    
    k = k
    i = i
    
    End If
Next
End Function
Function SortierenTicketIdAbsteigend2()
    Sheets("Tickets priorisieren").Range("A6:R500").Sort Key1:=Range("F6"), Order1:=xlDescending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End Function
 
 
 
	  
     |