Korrektur wegen Tabellennamen
06.01.2010 19:45:45
Tino
Hallo,
weil Deine Monate nicht wie von mir angegeben benannt sind
hier die Version wo Du die Tabellennamen angeben kannst.
kommt als Code in DieseArbeitsmappe
Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim A&
Dim meArG(), meArFG()
Dim i As Integer, sMonat$
Dim meArTabellen
'Tabellennamen eintragen
meArTabellen = Array("jan", "feb", "mär", "apr", "mai", "jun", "jul", "aug", "sep", "okt", "nov", "dez")
Redim Preserve MerkAr(0 To 11)
For i = Lbound(meArTabellen) To Ubound(meArTabellen)
With Sheets(meArTabellen(i)) 'Tabelle Jan bis Dez
MerkAr(i) = .Range("G16:G120").Value2
meArFG = .Range("G16:F120").Value2
meArG = MerkAr(i)
For A = 1 To Ubound(meArFG)
If meArFG(A, 1) <> "SW" Then
meArG(A, 1) = ""
End If
Next A
.Range("G16").Resize(Ubound(meArG)) = meArG
End With
Next i
Application.OnTime Now + TimeSerial(0, 0, 1), "NachPrint"
End Sub
kommt als Code in Modul1
Option Explicit
Private Declare Sub GetSafeArrayPointer Lib "msvbvm60.dll" Alias _
"GetMem4" (pArray() As Any, sfaPtr As Long)
Public MerkAr()
Sub NachPrint()
Dim sfaPtr As Long
Dim i As Integer
Dim meArTabellen
GetSafeArrayPointer MerkAr, sfaPtr
If sfaPtr > 0 Then
'Tabellennamen eintragen
meArTabellen = Array("jan", "feb", "mär", "apr", "mai", "jun", "jul", "aug", "sep", "okt", "nov", "dez")
For i = Lbound(meArTabellen) To Ubound(meArTabellen)
With Sheets(meArTabellen(i)) 'Tabelle Jan bis Dez
.Range("G16").Resize(Ubound(MerkAr(i))) = MerkAr(i)
End With
Next i
Erase MerkAr
End If
End Sub
Gruß Tino