Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1316to1320
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Blatt wechseln - Code tut nicht mehr

Blatt wechseln - Code tut nicht mehr
05.06.2013 13:52:25
jaytosh
Hallo zusammen,
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

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blatt wechseln - Code tut nicht mehr
05.06.2013 14:11:02
Rudi
Hallo,
die Löschroutine ist vollkommen unlogisch.
Erst ziehst du von intLastRow immer 1 ab wenn die Zeile komplett leer ist.
Dann löchst du die Zeilen, die in C leer sind.
Was soll der doppelte Durchlauf? Lösch doch direkt wenn das Kriterium erfüllt ist.
Und Aktivieren/ Selektieren muss man in VBA ohnehin nichts.
Teste mal.
Sub Copy2Report_V10000DIGITAL()
Dim intRow As Integer, intLastRow As Integer
Application.ScreenUpdating = False
' Daten zur Analyse hinzufügen
With Sheets("V10000 - Digital")
.Range(.Range("A43:DG43"), .Range("A43:DG43").End(xlDown)).Copy
End With
With Sheets("Analyse")
' Gehe zu 1. leere Zelle in Spalte A
.Cells(1, 1).End(xlDown).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'--> bis hier funktioniert es soweit.
'Leerzeilen löschen
intLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If IsEmpty(.Cells(intRow, 3)) Then
.Rows(intRow).Delete
End If
Next intRow
End With
Application.ScreenUpdating = True
Sheets("Projektübersicht").Activate
End Sub
Gruß
Rudi

Anzeige
AW: Blatt wechseln - Code tut nicht mehr
05.06.2013 14:27:10
jaytosh
Hallo Rudi,
funktioniert auf jeden Fall schon mal, vielen Dank. Es braucht aber komischerweise länger als zuvor.
Wie kann ich es den eingrenzen dass das Programm nicht soviel arbeiten muss?
Der Bereich der selektiert wird geht von A43:DG43 bis maximal A642:DG642. Wenn ich das mitunter bringe würde es die Laufzeit doch auf jeden Fall verkürzen, oder?
VG
Chris

AW: Blatt wechseln - Code tut nicht mehr
05.06.2013 16:12:45
Rudi
Hallo,
dann versuch's mal so:
Sub Copy2Report_V10000DIGITAL()
Dim intRow As Integer, intLastRow As Integer
Dim rDel As Range
Application.ScreenUpdating = False
' Daten zur Analyse hinzufügen
With Sheets("V10000 - Digital")
.Range(.Range("A43:DG43"), .Range("A43:DG43").End(xlDown)).Copy
End With
With Sheets("Analyse")
' Gehe zu 1. leere Zelle in Spalte A
.Cells(1, 1).End(xlDown).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'--> bis hier funktioniert es soweit.
'Leerzeilen löschen
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For intRow = 1 To intLastRow
If IsEmpty(.Cells(intRow, 3)) Then
If rDel Is Nothing Then
Set rDel = .Cells(intRow, 1)
Else
Set rDel = Union(rDel, .Cells(intRow, 1))
End If
End If
Next intRow
If Not rDel Is Nothing Then rDel.EntireRow.Delete
End With
Application.ScreenUpdating = True
Sheets("Projektübersicht").Activate
End Sub

Gruß
Rudi

Anzeige
AW: Blatt wechseln - Code tut nicht mehr
05.06.2013 16:16:41
jaytosh
Hi Rudi,
PERFEKT! Vielen, vielen Dank.
VG
Chris

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige