Hallo zusammen,

wir haben auf Arbeit ein Problem mit einem Makro und ich wurde gebeten, mich darum zu kümmern. Allerdings sind meine VBA-Fähigkeiten eher begrenzt...

Nun zum Problem: Wir haben eine Excel-Datei, in die aus anderen Dateien Werte pro Mitarbeiter zusammengetragen werden. Dies ist zum Beispiel die Anzahl von Ausschussteilen. Diese Ausschussteile werden verschiedenen Mitarbeitern (MA) zugeordnet und in einer separaten Datei erstellt. Die Datei mit dem Makro enthält wiederum auch die Namen der Mitarbeiter (in Spalte B, in Spalte A steht vor den Namen der MA ein X). In Spalte C steht dann hinter dem Namen der MA die Gesamtsumme für das Jahr und in allen weiteren Spalten ab Spalte D stehen dann die einzelnen Kalenderwochen, in die dann wöchentlich die Anzahl an Ausschussteilen pro MA rein soll. Also das ist sozusagen die "Empfänger-Datei".

In der "Sender-Datei" stehen die Namen der MA in Spalte B und es soll der Wert aus Spalte C übertragen werden. Die Reihenfolge der MA ändert sich hierbei wöchentlich, da in Spalte C absteigend nach den größten Werten sortiert wird. In der Empfänger Datei ist die Reihenfolge der MA allerdings chronologisch gleich.

Ich hoffe, dass war jetzt zunächst einmal verständlich. Falls nicht, lasst es mich bitte wissen! Unten habe ich den Code eingefügt. Der erste Teil beinhaltet das öffnen einer Input-Box. Diese stellt die geöffneten Excel-Dateien dar und fragt, aus welcher Datei die Werte importiert werden soll und in welche Zeile sie in der Empfänger-Datei eingefügt werden soll. Maximal soll man 4 Dateien gleichzeitig geöffnet haben. Das funktioniert auch soweit. Wenn man dann allerdings damit fortfährt, erscheint die Fehlermeldung: Laufzeitfehler 13 Typen unverträglich. 

Den ersten Part zu dieser Inputbox verstehe ich soweit auch. Ab "Application.ScreenUpdating = False" komme ich allerdings nicht mehr wirklich voran. 

Ich hoffe, dass mir jemand helfen kann. Ich bin auch für jegliche Erklärung bezüglich des grundlegenden Aufbaus dieses Makros sehr dankbar :-)

Public MAohne As String

Sub neue_KW_Ausschuss()



Dim tool As String

Ausschuss = ActiveSheet.Name
ziele = ActiveWorkbook.Name

spalte = InputBox("In welcher Spalte sollen die Meldungen eingetragen werden?", "Dateneingabe", ActiveCell.Column)
If spalte = "" Then Exit Sub
spalte = CInt(spalte)

Anzahl = Workbooks.Count
Select Case Anzahl
    Case 1: MsgBox ("Es wurden keine weitere Excelliste gefunden")
            Exit Sub
    Case 2: Daten = InputBox("Nr 1: " & Left(Workbooks(1).Name, 36) & vbCrLf & "Nr 2: " & Left(Workbooks(2).Name, 36), "Angabe Excelmappen mit Ausschussdaten?", "1")
    Case 3: Daten = InputBox("Nr 1: " & Left(Workbooks(1).Name, 36) & vbCrLf & "Nr 2: " & Left(Workbooks(2).Name, 36) & vbCrLf & "Nr 3: " & Left(Workbooks(3).Name, 36), "Angabe Excelmappen mit Ausschussdaten?", "1")
    Case 4: Daten = InputBox("Nr 1: " & Left(Workbooks(1).Name, 36) & vbCrLf & "Nr 2: " & Left(Workbooks(2).Name, 36) & vbCrLf & "Nr 3: " & Left(Workbooks(3).Name, 36) & vbCrLf & "Nr 4: " & Left(Workbooks(4).Name, 36), "Angabe Excelmappen mit Ausschussdaten", "1")
    Case Else
            MsgBox ("Es sind zu viele Exceldateien offen. Bitte reduzieren Sie die Anzahl auf maximal 4." & vbCrLf & "Vielen Dank.")
            Exit Sub
End Select

Application.ScreenUpdating = False

If Daten = "" Then Exit Sub
Daten = Workbooks(CInt(Daten)).Name

Workbooks(ziele).Activate
Anzahl = 0
For zeile = 3 To Worksheets(Ausschuss).Cells(100, "B").End(xlUp).Row Step 1
    If Worksheets(Ausschuss).Cells(zeile, "A").Value = "x" Then '(1)
        MA = Worksheets(Ausschuss).Cells(zeile, "B").Value
        
        Workbooks(Daten).Activate
            For lineD = 3 To Worksheets(3).Cells(100, "B").End(xlUp).Row Step 1
                If Worksheets(3).Cells(lineD, "B").Value = MA Then
                    Anzahl = Worksheets(3).Cells(lineD, "C").Value
                    Exit For
                End If
        
            Next lineD
            If lineD = Worksheets(3).Cells(100, "B").End(xlUp).Row Then Anzahl = "nicht gefunden"
            
        Workbooks(ziele).Activate
        Worksheets(Ausschuss).Cells(zeile, spalte).Value = Anzahl
            
    Anzahl = ""
    End If '(1)
    
Next zeile

End Sub