geht dies ohne activate
31.01.2016 16:30:54
Thomas
matthias L hatt mir lieberweise ein cooles macro geschrieben. dies funktioniert auch super. nun muss ich es aber aus einem anderen Blatt heraus starten. All meine anpassungsversionen führen dazu das dies macro fehlerhaft arbeitet. Zur zeit bekomme ich es nur hin wenn ich es mit "Tabelle1.Activate" verunstalte. Kann sich dies mal jemand vornehmen so das dies ohne Activate funktioniert? Sobald ich in dieser Zeile If Cells(x, 5) Cells(x, 6) Then das Tabellenblatt1 vorsetze funktioniert es irendwie nicht mehr.
besten dank schon mal für eure hilfe
liebe grüsse thomas
Sub Tagesfahrten_teilen_leerzeilen_löschen()
'von Matthias L aus Forum
On Error GoTo Fehler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'#################Sortieren
'With Worksheets("für kalender")
Worksheets("für kalender").Range("c2:i3000").Sort Key1:=Worksheets("für kalender").Range("e1"), _
Order1:=xlAscending, Header:=xlYes
'End With
Tabelle1.Activate ' das wieder raus?
Dim x&, i&
With Tabelle1
For x = 3000 To 2 Step -1
If Tabelle1.Cells(x, 9) = "Tagesfahrt" Then
If Cells(x, 5) Cells(x, 6) Then
Tabelle1.Rows(x + 1).Insert shift:=xlDown
Tabelle1.Cells(x + 1, 5) = .Cells(x, 6)
Tabelle1.Cells(x + 1, 6) = .Cells(x, 6)
Tabelle1.Cells(x, 6) = .Cells(x, 5)
Tabelle1.Cells(x + 1, 7) = .Cells(x, 7)
Tabelle1.Cells(x + 1, 9) = .Cells(x, 9)
End If
End If
Next
'End With
' löschen wenn spalte e leer
'MsgBox ActiveWorkbook.ActiveSheet.Name ' welches tabellenblatt bin ich
If WorksheetFunction.CountIf(Worksheets("für kalender").Range("e2:e3000"), "") > 0 Then _
Worksheets("für kalender").Range("e2:e3000").SpecialCells(xlCellTypeBlanks).Delete shift:= _
xlUp ' kann auch e:e sein
End With
' löscht wenn Spalte e leer ist die Zeile
Vorlage.Activate ' das wieder raus?
Fehler:
If Err.Number 0 Then MsgBox "Fehler:im Modul Tagesfahrten_teilen_leerzeilen_löschen " & _
Err.Number & vbLf & Err.Description
End Sub