Hallo,

ich habe nachfolgendes Skript geschrieben um aus einer Referenzliste Informationen in Materiallisten zu übertragen wenn eine gewisse Materialnummer übereinstimmt. Das klappt auf einzelnen Blättern, aber bei anderen Tabellenblättern überhaupt nicht. Könnt ihr einen Fehler sehen? Die Materialunterblätter sind alle identisch.

Sub Abgleich_Referenmaterial()
    
    'strg + g
    
   ' Dim intStart_StrukturZeile As Integer: intStart_StrukturZeile = 10
   ' Dim intStart_StrukturSpalte As Integer: intStart_StrukturSpalte = 12
    
    Dim letzteSpalte_current As Integer: letzteSpalte_current = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    Dim letzteZeile_current As Integer: letzteZeile_current = ActiveSheet.Cells(1048576, 11).End(xlUp).Row
    
    Dim letzteSpalte_Ref As Integer: letzteSpalte_Ref = ThisWorkbook.Worksheets("Referenzmaterial").UsedRange.SpecialCells(xlCellTypeLastCell).Column
    Dim letzteZeile_Ref As Integer: letzteZeile_Ref = ThisWorkbook.Worksheets("Referenzmaterial").Cells(1048576, 3).End(xlUp).Row
    
    Dim strSupplier As String: strSupplier = ""
    ''''''''''''''''''''''''''''''''''''''''''''''''
    '''' Befüllen der Struktur '''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''
    
    For i = 4 To letzteZeile_current
        
        If Len(ActiveSheet.Range("K" & CStr(i)).Value) >= 1 Then
            For j = 1 To letzteSpalte_Ref
                If InStr(ThisWorkbook.Worksheets("Referenzmaterial").Range("C" & CStr(j)).Value, ActiveSheet.Range("K" & CStr(i)).Value) > 0 Then
                    'TKZ-neu
                    ActiveSheet.Range("P" & CStr(i)).Value = ThisWorkbook.Worksheets("Referenzmaterial").Range("L" & CStr(j)).Value
                    'Warengruppe
                    ActiveSheet.Range("M" & CStr(i)).Value = ThisWorkbook.Worksheets("Referenzmaterial").Range("W" & CStr(j)).Value
                    'Komplexität
                    ActiveSheet.Range("N" & CStr(i)).Value = ThisWorkbook.Worksheets("Referenzmaterial").Range("K" & CStr(j)).Value
                    'Geplante Lieferanten
                        strSupplier = ThisWorkbook.Worksheets("Referenzmaterial").Range("Q" & CStr(j)).Value & "(" & ThisWorkbook.Worksheets("Referenzmaterial").Range("R" & CStr(j)).Value & ") / " & ThisWorkbook.Worksheets("Referenzmaterial").Range("S" & CStr(j)).Value & "(" & ThisWorkbook.Worksheets("Referenzmaterial").Range("T" & CStr(j)).Value & ") / " & ThisWorkbook.Worksheets("Referenzmaterial").Range("U" & CStr(j)).Value & "(" & ThisWorkbook.Worksheets("Referenzmaterial").Range("V" & CStr(j)).Value & ")"
                    ActiveSheet.Range("Q" & CStr(i)).Value = strSupplier
                        strSupplier = ""
                    'setzen, dass verwendetes Ref-Material ja
                    ThisWorkbook.Worksheets("Referenzmaterial").Range("A" & CStr(j)).Value = "ja"
                ' beenden, wenn gefunden und nächstes Material
                    Exit For
                End If
            Next
        End If
        
    Next
    
End Sub

Vielen Dank.

Gruß, David.