Makro auf jeder Seite durchführen
23.10.2006 18:32:50
Jürgen
man lernt ja dazu und dann möchte noch mehr lernen. Mit Unterstützung aus dem Forum habe ich eine Schleife gebastelt, die in Abhängigkeit eines Suchkriteriums in B1 und einer über eine Inputbox eingegebene Zeilen-Nr. Sverweise schreibt. D.h. daß ich je Blatt einmal einen Button drücke und die Formeln dann eingetragen werden. Nun habe ich aber mehrere Blätter in einer Datei, die alle gleich aufgebaut sind, nur das Suchkriterium ist ein anderes.
Nun wäre ich glücklich, wenn mir jemand sagen könnte, wie ich das nachfolgende Skript ergänzen muß um nur einmal eine ZeilenNr. eingeben zu müssen und das Makro dann von Blatt zu Blatt springt und sich jeweils das Suchkriterium für das jeweilige Blatt dazu zieht.
Hier das Listing:
Sub Kostenverdichtung_Budget()
' Mit dem Makro sollen Sverweise erstellt werden, _
der sich zusammensetzen soll _
aus einem konstanten Pfad (Pfad) _
einem Dateinamen, der aus Spalte A (Zeilennummer über i) ausgelesen wird _
einem konstanten Blattnamen (Blatt) und einem Suchkriterium aus _
Zelle B1 zusammensetzt
Dim KoSt ' Dateiname aus Spalte A
Dim i ' Nr. der Zeile, die aktualisiert werden soll aus Spalte A
Dim Rückfr ' Inputbox zur Eingabe der ZeilenNr. i
Dim Pfad ' Pfad mit den Quelldaten
Dim Blatt ' Blattname (immer gleich)
Dim c ' Zielspalte
Dim wsCount ' Anzahl Arbeitsblätter
On Error GoTo Errorhandler
wsCount = ActiveWorkbook.Worksheets.Count
'Pfad in dem die Quelldatei liegt
Pfad = "'O:\200CC [...]\Budget 2007\04 Sammelordner\03 Übersicht_Bud\"
Blatt = "Übersicht_Budget_07"
Rückfr = InputBox("Welche Zeile soll aktualisiert werden", "Zeilennummer eingeben")
' For Each Worksheet 1 to wsCount
i = Rückfr
KoSt = Range("A" & i).Value
'Prüfung, ob in Spalte A ein Dateiname steht (KoSt <> "leer)
If KoSt = "" Then
MsgBox ("In Zelle A" & i & " ist kein Dateiname eingetragen." & Chr(10) & _
"Bitte Eingabe überprüfen und erneut probieren!"), vbCritical
Exit Sub
End If
c = 4 ' D
' Eintragen der Formeln
' Spalte D
Cells(i, c).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,3,FALSE)"
' Spalte E
Cells(i, c + 1).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,4,FALSE)"
' Spalte F
Cells(i, c + 2).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,5,FALSE)"
' Spalte G
Cells(i, c + 3).FormulaR1C1 = "=VLOOKUP(R1C2," & Pfad & "[" & KoSt & "]" & Blatt & "'!R3C1:R300C6,6,FALSE)"
' Spalte K Datum der Durchführung
Cells(i, c + 7).Value = Date
' Spalte L Uhrzeit der Durchführung
Cells(i, c + 8).Value = Time
Cells(i, c + 8).NumberFormat = "h:mm"
Exit Sub
Errorhandler:
MsgBox ("Die Prozedur wurde aufgrund eines Fehlers abgebrochen." & Chr(10) & _
"Wahrscheinlich existiert die Datei: " & KoSt & " nicht " & Chr(10) & _
"oder der Dateiname wurde nicht richtig in Zelle A" & i & " eingetragen!"), vbCritical, "Prüfen und wiederholen!"
Exit Sub
End Sub