hoffe mir kann jemand helfen da ich selbst mal wieder leider nicht weiterkomme.
Habe folgenden Code den ich bisher immer aus einem Tabellenblatt gestartet habe.
Dabei werden Daten in ein anderes Tabelllenblatt kopiert zur weiteren Analyse.
Den Code hatte ich bisher in "Diese Arbeitsmappe" gespeichert, da die Vorlage mehrmals genutzt wird.
Hier der Code:
Sub Copy2Report()
' Daten zur Analyse hinzufügen
Range("A43:DG43").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Analyse").Select
' Gehe zu 1. leere Zelle in Spalte A
Cells(1, 1).End(xlDown).Offset(1, 0).Select
' Inhalte einfügen "Werte"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Leerzeilen löschen
Dim intRow As Integer, intLastRow As Integer
Application.ScreenUpdating = False
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 3)) Then
Rows(intRow).Delete
End If
Next intRow
Application.ScreenUpdating = True
End Sub
Hat bisher auch wunderbar funktioniert.Nun habe ich ein weiteres Tabellenblatt eingefügt, welches eine Übersicht für die Tabellenblätter darstellt. Aus diesem wollte ich den gleichen Code starten, was aber leider nicht funktioniert hat.
Den Anfang konnte ich mit einer Krücke lösen (gibt es bestimmt auch was eleganteres), aber komplett aussteigen tut das Programm wenn die Leerzeilen gelöscht werden sollen.
Hier der neue Code:
Sub Copy2Report_V10000DIGITAL()
' Daten zur Analyse hinzufügen
Sheets("V10000 - Digital").Activate
Sheets("V10000 - Digital").Range("A43:DG43").Select
Sheets("V10000 - Digital").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Analyse").Activate
' Gehe zu 1. leere Zelle in Spalte A
Sheets("Analyse").Cells(1, 1).End(xlDown).Offset(1, 0).Select
' Inhalte einfügen "Werte"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
--> bis hier funktioniert es soweit.
'Leerzeilen löschen
Dim intRow As Integer, intLastRow As Integer
Application.ScreenUpdating = False
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 3)) Then
Rows(intRow).Delete
End If
Next intRow
Application.ScreenUpdating = True
Sheets("Projektübersicht").Activate
End Sub
Was muss ich den tun dass auch dieser Bereich wieder läuft?Muss ich das Blatt irgendwie anders aktivieren um zum Erfolg zu kommen?
Wäre für eine Lösung riesig dankbar.
Gruß
Chris