hänge mal wieder bei vba. und zwar hab ich eine export tabelle (Tabelle1)die zwischen den relevanten Zeile leere zeilen und spalten hat. nun möchte ich diese tabelle in ein neues blatt kopieren, weiß aber nicht wie ich die größe ermitteln kann trotz der leerzeilen und spalten.aus den zeilen die nur teilweise gefüllt sind sollen teilweise informationen vor die spalten mit datum kopiert werden. Das funktioniert auch.
Die Tabelle soll dann eigentlich so aussehen die in Datenbasis, da dort eine Pivot draufgelegt werden soll.
Folgendes hab ich bereits, wenn auch nicht sonderlich professionell.
Weiß jemand wie ich die größe der tabelle ermitteln kann trotz der eeren spalten und zeilen?
https://www.herber.de/bbs/user/61995.xlsx
Sub Startroutine()
Application.ScreenUpdating = False
'Hier soll noch was hin damit die Daten in Tab Daten_Basis E2 kopiert werden.
'die Größe der Tabelle zu ermitteln,Hürde sind die leer Zeillen und Spalten.
'Dann kann Spalten_einfügen weg.
Kst_kopieren
Kostenart
Name_Kst
Name_Kostenart
'fehlt Kopieren bis Ende Tabelle, wieder Hürde die leer Zeilen.
einfuegen_werte
ZellenAusfuellen
LeereZeilenLöschen
Application.ScreenUpdating = True
End Sub
Sub Kst_kopieren()
' Kst_kopieren Makro
Range("A5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[4]=""Kostenstelle"",R[-3]C[6],"""")"
End Sub
Sub Kostenart()
Range("C5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[2]=""Kostenart"",R[-1]C[4],"""")"
End Sub
Sub Name_Kst()
Range("B5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-3]C[3]=""Kostenstelle"",R[-3]C[9],"""")"
End Sub
Sub Name_Kostenart()
Range("D5").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[1]=""Kostenart"",R[-1]C[8],"""")"
End Sub
Sub einfuegen_werte()
Columns("A:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Sub ZellenAusfuellen()
Dim Zelle As Range
Application.ScreenUpdating = False
For Each Zelle In Range("A5:D" & Cells(Rows.Count, "D").End(xlUp).Row)
If Zelle = "" Then Zelle = Zelle.Offset(-1, 0)
Next
Application.ScreenUpdating = True
End Sub
Sub LeereZeilenLöschen()
Dim i As Long
Dim n As Long
Dim zeileletzte As Long
zeileletzte = Active.Sheet.UsedRange.Rows.Count
For i = zeileletzte To 1 Step -1
If Cells(i, 6) = "" And Cells(i, 8) = "" Then
Rows(i).EntireRow.Delete
n = n + 1
End If
Next i
MsgBox "Es sind" & Format(n, "#,##0") & _
"Zeilen gelöscht worden!", _
vbInformation, ""
End Sub
Grüße Carmen