VBA Hilfe
15.09.2015 09:14:12
Roffel89
ich benötige Hilfe bei meinem Code.
Mir geht es hier um den 'sheet selector. Ich habe in Excel bisher die Tabellenblätter (von links nach rechts) Summary, 30112015, Dokumentation und Cockpit.
Und immer wenn ich in Zukunft eine neue Prüfung durchführen möchte, erweitere ich die Arbeitsmappe um ein neues Tabellenblatt mit dem Datum und füge es rechts neben das letzte Datum, in dem Fall 30112015.
In meinem bisherigen Code, weiße ich oben Sheet ja direct dem aktuellen Tabellenblatt 30112015. Wie kann ich das lösen, dass ich bei der nächsten Prüfung, nicht den vba Code anpassen muss, sondern er automatisch bei einer Prüfung das neueste Tabellenblatt auswählt?
Wäre super, wenn das jemand wüsste.
Public Sub testClient()
Dim sheet As String
'sheet selector
sheet = "30112015"
'Summary Zeile mit Datum und Anzahl der Datensätze
Dim summary As Integer
summary = checkList(sheet, 13, "Fall 4")
summary = summary + checkList(sheet, 12, "Fall 3")
summary = summary + checkList(sheet, 11, "Fall 2")
summary = summary + checkList(sheet, 10, "Fall 1")
Call newLineAndFormat
Sheets("Summary").Cells(15, 2).Value = "=TODAY()"
Sheets("Summary").Cells(15, 6).Value = summary
Sheets("Summary").Activate
End Sub
Function checkList(sheet As String, caseColumn As Integer, Optional label As String = "") As Integer
Dim currentRow As Long
Dim counter As Integer
'Checking List
For currentRow = Sheets(sheet).Cells.SpecialCells(xlLastCell).Column To 2 Step -1
If (Sheets(sheet).Cells(currentRow, caseColumn).Value = "True" Or _
Sheets(sheet).Cells(currentRow, caseColumn).Value = "Wahr") Then
Call newLineAndFormat
Sheets("Summary").Cells(15, 4).Value = Sheets(sheet).Cells(currentRow, 1).Value
counter = counter + 1
End If
Next currentRow
'Summary row
Call newLineAndFormat
Sheets("Summary").Cells(15, 4).Value = label
Sheets("Summary").Cells(15, 6).Value = counter
Sheets("Summary").Activate
checkList = counter
End Function
Private Sub newLineAndFormat()
Sheets("Summary").Activate
Sheets("Summary").Rows("15:15").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Summary").Range("16:16").Copy
Sheets("Summary").Rows("15:15").PasteSpecial Paste:=xlPasteFormats
Sheets("Summary").Range("B15").Select
Application.CutCopyMode = False
End Sub