Hallo zusammen,
ich habe ein Problem bei dem ich selbst nicht ganz weiterkomme. Ich hoffe ihr wisst rat.
Mit unten stehendem Code will ich mehr oder weniger eine Index-Funktion nachbilden, die an 3 Parametern hängt. Ich habe das in einem Testsheet gebaut und da funktioniert es auch einwandfrei. (Ziel ist es in eine beliebe Zahl an sheets, die Informationen aus der "ABC_Summary" zu kopieren. Parameter sind dabei jeweils Spalte C, Zelle o5, und die ersten 3 Zeichen aus Zelle r5). In dem eigentlichen Sheet, dass ich immer von unserem Server auf der Arbeit herunterladen muss friert Excel leider jedes mal ein, wenn ich es anwende.
Jetzt kann ich die eigentliche Datei hier nicht hochladen, da es eine Menge sensibler Daten enthält, die ich nicht anonymisieren kann und eine Beispieldatei bringt nicht viel, da es da ja funktioniert.
Seht ihr in dem code potentielle Stellen, an denen man den Code vereinfachen kann oder wo er sich vll mit anderen Codes im sheet beist.
Sorry für das recht kniffelige Setting.
Danke schoneinmal für eure Hilfe
Beste Grüße
Ben
Dim Zeile As Long
Dim Zeile1 As Long
Dim Blatt As Long
Dim Abschnitt As String
Dim code As String
For Blatt = 1 To Sheets.Count
If Sheets(Blatt).Name = "Master List" Or Sheets(Blatt).Name = "Cockpit" Or Sheets(Blatt).Name = "Report-ByPCL" Or Sheets(Blatt).Name = "ABC_Summary" Or Sheets(Blatt).Name = "Report-ByTheme" Or Sheets(Blatt).Name = "Report-ByStore" Or Sheets(Blatt).Name = "Report-WeeksCover" Or Sheets(Blatt).Name = "SelectionCriteria " Then
Else
For Zeile1 = 30 To Sheets(Blatt).Cells(Rows.Count, "C").End(xlUp).Row
For Zeile = 1 To Sheets("ABC_Summary").Cells(Rows.Count, "B").End(xlUp).Row
code = Left(Sheets(Blatt).Range("R5").Text, 3)
If Sheets(Blatt).Range("C" & Zeile1).Value = Sheets("ABC_Summary").Range("B" & Zeile).Value And Sheets(Blatt).Range("O5").Value = Sheets("ABC_Summary").Range("ap" & Zeile).Value And code = Sheets("ABC_Summary").Range("AQ" & Zeile).Value Then
Abschnitt = "AE" & Zeile & ":" & "AI" & Zeile
Sheets("ABC_Summary").Range(Abschnitt).Copy
Sheets(Blatt).Cells(Zeile1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Else
End If
Next Zeile
Next Zeile1
End If
Next Blatt