|
Leider läuft die Schleife so endlos ohne Ergebnis.
Option Explicit
Sub Grafik()
Dim Ziel As Worksheet, Quelle As Worksheet, Home As Worksheet
' <<< Spalten in Quelldatei, die in Zieldatei übernommen werden >>>
Const csSpalten = "A1"
' <<< Quelldatei öffnen >>>
Workbooks.Open xxxxx, Password:=xxxxxx
' <<< Quell- und Zielblatt setzen >>>
Set Quelle = Worksheets("Datenerfassung")
Set Ziel = ThisWorkbook.Worksheets("Grafik")
Set Home = ThisWorkbook.Worksheets("Startseite")
sArr = Split(csErsetz, ",")
sBer = Split(csSpalten, ",")
' <<< Datum in Jahr umwandlen >>>
Quelle.Range("AQ:AQ, AC:AC").NumberFormat = "YYYY"
i = 0
Do
Spalte_Suchen = "2000" + i
If Spalte_Suchen = "" Then Exit Sub
' <<< Erste Ausgabezeile in der Zieldatei >>>
Ausgabe_Zeile = 17
' <<< Erstes Feld mit dem Suchbegriff suchen >>>
Set Objekt_Finden = Quelle.Range("AC:AC").Find _
(Spalte_Suchen, LookIn:=xlValues, LookAt:=xlWhole)
If Not Objekt_Finden Is Nothing Then
Spalte_ErsteAdresse = Objekt_Finden.Address
Do
Ausgabe_Zeile = Ausgabe_Zeile - 1
For n = 0 To UBound(sBer)
Ziel.Cells(Ausgabe_Zeile, n + 2 + i).Value _
= Quelle.Range(Replace(sBer(n), "1", Objekt_Finden.Row)).Value
Next n
' <<< Schleife für nächsten Suchbegriff >>>
Set Objekt_Finden = Quelle.Range("AC:AC").FindNext(Objekt_Finden)
Loop While Not Objekt_Finden Is Nothing And Objekt_Finden.Address <> Spalte_ErsteAdresse
End If
If i = 10 Then Exit Do
Loop
End Sub
|