Hallo Leute,
ich habe eine Datei mit unterschiedlich langen Tabellenblättern (entweder 90 Zeilen oder 50 Zeilen) und lasse diese befüllen über einen Array. Beim leeren dieser Tabellenblätter wird allerdings der gleiche Array verwendet und das haut einfach nicht hin.
Da das leeren der Tabellen nun den Array benutzt, befüllt er die kurzen Tabellen (50 Zeichen) erst ab der 51. Zeile.
Da Arrays nicht gerade meine Stärke sind kann mir vielleicht einer von Euch helfen ?
Sub DatenTransferieren(strZeitintervall$)
Dim wksStorno As Worksheet, wksZiel As Worksheet
Dim lngZeileStorno&, lngZeileZiel&
Dim HFL_Abt$, StartDatum As Date, EndDatum As Date
Dim arrTabellen, strTabName, i%
Set wksStorno = ActiveWorkbook.Worksheets("Stornos Gesamt")
arrTabellen = Array("853", "856", "859", "862", "868", "874", "886", "889", "AM", "GIP", "TR", "WHS", "HD", "FKA", "ZIA", "Sonstige") 'Liste der Zieltabellen
'Altdaten in Zieltabellen löschen
For Each strTabName In arrTabellen
Set wksZiel = ActiveWorkbook.Worksheets(strTabName)
'For Each strTabName In arrTabellen
With wksZiel
Select Case wksZiel.Name
Case "853", "856", "859", "862", "868", "874", "886", "889", "AM"
.Range(.Cells(7, 2), .Cells(89, 6)).ClearContents
.Range(.Cells(7, 8), .Cells(89, 9)).ClearContents
Case "GIP", "TR", "WHS", "HD", "FKA", "ZIA", "Sonstige"
.Range(.Cells(7, 2), .Cells(49, 6)).ClearContents
.Range(.Cells(7, 8), .Cells(49, 9)).ClearContents
Case Else
End Select
End With
Next strTabName
'Periodenauswahl auswerten
Select Case strZeitintervall
Case "Letzter Monat"
StartDatum = DateSerial(Year(Date), Month(Date) - 1, 1)
EndDatum = DateSerial(Year(Date), Month(Date), 0)
Case "Letztes Vierteljahr"
StartDatum = DateSerial(Year(Date), Month(Date) - 3, 1)
EndDatum = DateSerial(Year(Date), Month(Date), 0)
Case "Gesamtes Jahr"
StartDatum = DateSerial(Year(Date), Month(Date) - 12, 1)
EndDatum = DateSerial(Year(Date), Month(Date), 0)
End Select
'Werte übertragen
For lngZeileStorno = 6 To wksStorno.Cells(wksStorno.Rows.Count, 2).End(xlUp).Row
For i = LBound(arrTabellen) To UBound(arrTabellen)
'HFL/Abt mit Tabellennamen vergleichen
If IsNumeric(wksStorno.Cells(lngZeileStorno, 2)) Then
HFL_Abt = Format(wksStorno.Cells(lngZeileStorno, 2), "000")
Else
HFL_Abt = wksStorno.Cells(lngZeileStorno, 2)
End If
If HFL_Abt = arrTabellen(i) Then
'Datum mit Auswertezeitraum vergleichen
If wksStorno.Cells(lngZeileStorno, 4) >= StartDatum And _
wksStorno.Cells(lngZeileStorno, 4) Set wksZiel = ActiveWorkbook.Worksheets(arrTabellen(i))
'nächste freie Zeile in Zieltabelle oberhalb von Zeile 89 ermitteln
lngZeileZiel = wksZiel.Cells(89, 2).End(xlUp).Row + 1
If lngzeile = 89 Then
MsgBox "In der Zieltabelle " & arrTabellen(i) _
& " sind schon 89 Zeilen ausgefüllt!" & vbLf _
& vbLf & "Datenübertragung wird abgebrochen!!"
Exit Sub
End If
With wksStorno
.Range(.Cells(lngZeileStorno, 2), .Cells(lngZeileStorno, 6)).Copy _
Destination:=wksZiel.Cells(lngZeileZiel, 2)
.Range(.Cells(lngZeileStorno, 8), .Cells(lngZeileStorno, 9)).Copy _
Destination:=wksZiel.Cells(lngZeileZiel, 8)
End With
End If
Exit For
End If
Next i
Next lngZeileStorno