Zellen auf Inhalt prüfen

Option Explicit
Dim strDatei As String
Dim istDa As Boolean
Dim Zeilenzahl As Integer
Dim intZeile As Integer
Dim a As Integer
Dim b As Integer
Dim wks As Worksheet
Dim arr
Dim zielmappe As String
Dim quellmappe As String
Dim ZM As Workbook
Dim zelle As Variant

Public Sub Start()
Call öffnen
End Sub



Public Sub öffnen()

zielmappe = ActiveWorkbook.Name

Set ZM = ThisWorkbook

b = 3

zelle = Cells(b, 6)

strDatei = Application.GetOpenFilename()

Workbooks.Open strDatei

quellmappe = ActiveWorkbook.Name

Windows(quellmappe).Activate

Cells.Select

Selection.Copy

Windows(zielmappe).Activate

Cells.Select

ActiveSheet.Paste

Application.DisplayAlerts = False

Windows(quellmappe).Close

Application.DisplayAlerts = True

ActiveSheet.Name = Left((Range("B3")), 5) & "_" & Right((Range("B3")), 4)

Call sortieren

End Sub



Public Sub sortieren()

strDatei = Application.GetOpenFilename()

Workbooks.Open strDatei

quellmappe = ActiveWorkbook.Name

intZeile = 29

Zeilenzahl = Range("D29", Range("D29").End(xlDown)).Rows.Count

arr = Array()

For a = 0 To Zeilenzahl - 1

ReDim Preserve arr(a)

arr(a) = Cells(intZeile, 3).Value & "_" & Cells(intZeile, 4).Value

intZeile = intZeile + 1

Next a

With ZM

Application.DisplayAlerts = False

For Each zelle In .Worksheets

For a = LBound(arr) To UBound(arr)

If zelle.Name = arr(a) Then istDa = True

Next a

If Not istDa Then zelle.Delete

istDa = False

Next zelle

End With

End Sub