Sub get_all_title()

Dim sheet As Integer
Dim sheet_counter_start As Integer
Dim sheet_counter_end As Integer
Dim row_search As Integer
Dim title_search As Integer
Dim title_paste_start As Integer
Dim title_paste_next As Integer
Dim title_paste_end As Integer
Dim duplicates As Integer
Dim duplicates_start As Integer
Dim duplicates_end As Integer
Dim duplicates_search As Integer
Dim duplicates_counter As Integer
Dim duplicates_all As Integer
Dim commercial_finder As String
Dim num_finder As Integer
Dim copy_start As Integer
Dim copy_end As Integer
Dim copy_dif As Integer
Dim copy_max As Integer
Dim start_paste As Integer


Dim testarray


'Application.ScreenUpdating = False

title_paste_start = 11
title_paste_next = title_paste_start

sheet_counter_start = 2
sheet_counter_end = Sheets.Count

'Alle Sheets durchlaufen (von 2 bis Ende)
For sheet = sheet_counter_start To sheet_counter_end
    Sheets(sheet).Select
    
    'Anhand von "No." den titel finden
    For row_search = 1 To 1000
        If Cells(row_search, 1) = "No." Then
            title_search = row_search - 1
            
            'Titel finden und falsche Werte ausschließen / danach kopieren und in Sheet 1 einfügen
            If Cells(title_search, 1).Value = "Ersteinsätze" Or Cells(title_search, 1).Value = "Saalbezogen(gültigfüralleFilme)." Then
            Else
                Cells(title_search, 1).Select
                Selection.Copy
                'MsgBox "Gefunden: " & Cells(title_search, 1)
                Sheets(1).Select
                Cells(title_paste_next, 1).Select
                ActiveSheet.Paste
                Sheets(sheet).Select
                title_paste_next = title_paste_next + 1
                title_paste_end = title_paste_next
            End If
        End If
    Next row_search
Next sheet

Sheets(1).Select

'Duplikate entfernen
duplicates_start = title_paste_start
duplicates_end = title_paste_end
duplicates_search_start = title_paste_start
duplicates_search_end = title_paste_end

For duplicates = duplicates_start To duplicates_end
    For duplicates_search = duplicates_search_start To duplicates_search_end
        If duplicates = duplicates_search Then
        Else
            If Cells(duplicates, 1) = Cells(duplicates_search, 1) And (Cells(duplicates_search, 1)) <> "" Then
                Cells(duplicates_search, 1).Delete
                duplicates_search = duplicates_search - 1
                duplicates_end = duplicates_end - 1
                duplicates_counter = duplicates_counter + 1
            End If
        End If
    Next duplicates_search
Next duplicates
duplicates_end = duplicates_end - 1
duplicates_all = duplicates_end - duplicates_start + 1
MsgBox (duplicates_counter) & (" Duplikate gefunden/gelöscht")


'Ergebniss sortieren
Cells(title_paste_start, 1).Select
ActiveWorkbook.Worksheets("Analyse").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Analyse").Sort.SortFields.Add Key:=ActiveCell, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Analyse").Sort
    .SetRange Range(Cells(title_paste_start, 1), Cells(duplicates_end, 1))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Werbung holen

For duplicates = 11 To 1000

    If IsEmpty(Cells(duplicates, 1)) Then
    Else
    
        Sheets(1).Select
        commercial_finder = Cells(duplicates, 1).Value
        copy_max = 0
        
        For sheet = sheet_counter_start To sheet_counter_end
            Sheets(sheet).Select
            For row_search = 1 To 1000
                If Cells(row_search, 1).Value = commercial_finder Then
                    num_finder = row_search
                    Do Until IsNumeric(Cells(num_finder, 1))
                        num_finder = num_finder + 1
                    Loop
                    copy_start = num_finder
                    
                    Do While IsNumeric(Cells(num_finder, 1))
                        num_finder = num_finder + 1
                        If Cells(num_finder, 1) = "Presenter2D" Or Cells(num_finder, 1) = "Presenter3D" Then
                            num_finder = num_finder + 1
                        End If
                    Loop
                    num_finder = num_finder - 1
                    copy_end = num_finder
                    copy_dif = copy_end - copy_start + 1
                    
                    'Range(Cells(copy_start, 2), Cells(copy_end, 2)).Select
                    'Selection.Copy
                    MsgBox ("")
                    
                    If copy_max < copy_dif Then
                        copy_max = copy_dif
                    End If
                End If
            Next row_search
        Next sheet
        
        Sheets(1).Select
        
        For row_search = 11 To 1000
            If Cells(row_search, 1).Value = commercial_finder Then
                insert_row = row_search + 1
                Cells(insert_row, 2).Select
                MsgBox (copy_max)
                
                For insert_rowx = 0 To copy_max
                    ActiveCell.EntireRow.Insert
                Next insert_rowx

                
            End If
        Next row_search
        
       
        MsgBox ("xx")
       
        
        
        
           
    End If
Next duplicates

'ActiveCell.EntireRow.Insert
'ActiveCell.EntireRow.ClearContents

Sheets(1).Select
'Application.ScreenUpdating = True


End Sub