Abarbeiten einer Liste von Werten
05.03.2018 11:46:17
Werten
aus einer mit einer externen Datenquelle verknüpften Exceldatei wird ein Kostenstellenbericht generiert (eine Datei pro Kostenstelle). Dazu wird im Sheet Parameters in zelle B2 die Company ausgewählt, in Zelle B3 die Kostenstelle. Danach werden die Sheets mit den Daten in eine neue Datei wegkopiert, die Verknüpfungen zur externen Datei gelöscht und unter dem Namen der Kostenstelle gespeichert.
Das untenstehende Makro macht derzeit genau das für eine einzelne Kostenstelle, im Beispiel für die KSt 2001.
Sub exp_KSt()
If Len(Dir(ThisWorkbook.Path & "\KSt Templates", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\KSt Templates"
End If
Sheets("Parameters").Range("B2").Value = "JW"
Sheets("Parameters").Range("B3").Value = "2001"
Calculate
Dim Filename
Dim i As Integer
Dim WBK As Workbook
Dim WST As Worksheet
Filename = Sheets("Parameters").Range("D3").Text & "out"
With Worksheets(Array("Parameters", "Final", "Overlay", "Summary", _ ))
.Copy
Set WBK = ActiveWorkbook
End With
vLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
For lLink = LBound(vLinks) To UBound(vLinks)
ActiveWorkbook.BreakLink _
Name:=vLinks(lLink), _
Type:=xlLinkTypeExcelLinks
Next lLink
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\KSt Templates\" & Filename, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close True
End Sub
Was das Makro idealerweise machen sollte:
die Liste aller Kostenstellen abarbeiten, wobei diese Liste auf Sheet "Parameters" in den Zellen A1300:A1370 steht und variabel sein kann.
Woran ich derzeit scheitere ist, die Anweisung
Sheets("Parameters").Range("B3").Value = "Kostenstelle"
in einen Loop einzubauen, der die Zeilen ab A1300 abarbeitet, bis er keinen Wert mehr vorfindet.
Bin für alle Anregungen dankbar.