Zeilen markieren und löschen

Hallo Excelfans, ganz besonders hary,
hary hat mir ein tolles Makro um Zeilen zu löschen geschrieben. Dieses habe ich jetzt ausführlich getestet und funktioniert mit einer Ausnahme: wenn in a2 und a4 je ein Wert steht und dazwischen je eine Leerzeile, haut er auf einen Schlag 4 Zeilen weg. Dieses kann nicht sein, da sonst Werte verloren gehen.
https://www.herber.de/bbs/user/89024.xls
Hier die Bitte an alle, ganz besonders an hary nochmal darüber schauen, vielleicht fällt jemand etwas auf.
Bei dieser Gelegenheit noch eine andere Frage. Ich arbeite mit einer Datenbank mit dessen Script kann ich auf das o.g. Sheet zugreifen und die Daten daraus importieren.
Besteht die Möglichkeit mittels dem Datenbankscript das Makro in dem Sheet auszuführen. Was für einen Pfad muß man da angeben?
Vielen Dank
wolf

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With Sheets("Tabelle1") If .Cells(2, 1) = "" Then Exit Sub 'pruefen ob in A2 was drinsteht .Cells(2, 1).Resize(.Cells(1, 1).End(xlDown).Row - 1).EntireRow.Delete Do While .Cells(2, 1) = "" If .Cells(.Rows.Count, 1).End(xlUp).Row = 1 Then Exit Do End If .Rows(2).Delete Loop .Range("M2") = Application.CountA(.Cells(2, 1).Resize(.Cells(1, 1).End(xlDown).Row - 1)) End With

Moin wolf
So nu teste mal am WE. Beide Mappen muessen geoeffnet sein!!

Sub starten()
'--Makro in die Startmappe
'--Mappenname und Makroname anpassen
Application.Run ("'89024.xls'!Makro1") 'startet das Makro in der anderen geoeffneten Mappe
End Sub

In die Loeschmappe

Sub Makro1()
'---------Makro in der Loeschmappe --------------
'----Mappenname und Blattname anpassen!!!!!!-----
With Workbooks("89024").Sheets("Tabelle1")
If .Cells(2, 1) = "" Then Exit Sub 'pruefen ob in A2 was drinsteht
.Cells(2, 1).Resize(.Cells(1, 1).End(xlDown).Row - 1).EntireRow.Delete
Do While .Cells(2, 1) = ""
If .Cells(.Rows.Count, 1).End(xlUp).Row = 1 Then
Exit Do
End If
.Rows(2).Delete
Loop
.Range("M2") = Application.CountA(.Cells(2, 1).Resize(.Cells(1, 1).End(xlDown).Row - 1))
If .Range("M2") > 500 Then .Rows(502).Insert Shift:=xlDown 'Leerzeile einfuegen
End With
End Sub

gruss hary

If Application.CountA(.Cells(2, 1).Resize(.Cells(1, 1).End(xlDown).Row - 1)) > 500 Then .Rows(502).Insert Shift:=xlDown 'Leerzeile einfuegen End If .Range("M2") = Application.CountA(.Cells(2, 1).Resize(.Cells(1, 1).End(xlDown).Row - 1))

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen markieren und löschen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread