Einrücken eines Markierten Bereichs

Forumthread: Einrücken eines Markierten Bereichs

19.03.2008 10:51:05

Edmund

Hallo zusammen!
Zusammen mit einem Kollegen habe ich bereits folgendes Makro geschrieben:


Sub ordnen()
Dim x As Integer
With Tabelle1
For x = 1 To .UsedRange.Rows.Count
If WorksheetFunction.CountA(.Rows(x)) > 0 Then
Do Until .Cells(x, 1)  ""
.Cells(x, 1).Delete Shift:=xlToLeft
Loop
End If
Next x
End With
End Sub

Es soll die Inhalte einer importierten Tabelle die ziemlich durcheinander ist in die erste Spalte einrücken. Klappt bisher auch recht gut, allerdings habe ich noch zwei Fragen dazu:
Ist es möglich dieses Makro so umzsuchreiben, dass es nur auf einen markierten Bereich angewendet wird?
Und wieso kann ich nicht aus einer anderen Mappe daraufzugreifen, selbst wenn die, die das Makro enthällt geöffnet ist?
Gruß

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Einrücken eines Markierten Bereichs

19.03.2008 13:34:07

fcs

AW: Einrücken eines Markierten Bereichs

19.03.2008 13:34:07

fcs

Hallo Edmund,
Tabelle1 bezieht sich meines wissens immer auf die Tabelle in der Arbeitsmappe in der das Makro erstellt ist.
Mit folgenden Anpssungen wird das Makro allgemeiner anwendbar.
Für einen selektierten Zellbereich die 2. Variante anwenden, dabei muss das Blatt mit der Selektion das aktive Blatt sein.
Gruß
Franz


Sub ordnen()
'Zellen im Blatt nach links aufrücken
Dim x As Integer, ws As Worksheet
Set ws = ActiveSheet
' Varianten für Worksheet-Festlegung
'Set ws = ActiveWorkbook.Worksheets(1)
'Set ws = Workbooks("datei1.xls").Worksheets("Tabelle1")
With ws
Application.ScreenUpdating = False
For x = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
If WorksheetFunction.CountA(.Rows(x)) > 0 Then
Do Until .Cells(x, 1)  ""
.Cells(x, 1).Delete Shift:=xlToLeft
Loop
End If
Next x
Application.ScreenUpdating = True
End With
End Sub
Sub ordnen2()
'Zellen im Bereich nach links aufrücken
Dim x As Integer, ws As Worksheet, Bereich As Range, Spalte As Long
Set ws = ActiveSheet
Set Bereich = Selection
Spalte = Bereich.Column
With ws
Application.ScreenUpdating = False
For x = Bereich.Row To Bereich.Row + Bereich.Rows.Count - 1
If WorksheetFunction.CountA(.Range(.Cells(x, Spalte), _
.Cells(x, Spalte + Bereich.Columns.Count - 1))) > 0 Then
Do Until .Cells(x, Spalte)  ""
'Leerzelle links löschen
.Cells(x, Spalte).Delete Shift:=xlToLeft
'Leerzelle rechts einfügen
.Cells(x, Spalte + Bereich.Columns.Count - 1).Insert Shift:=xlToRight
Loop
End If
Next x
Application.ScreenUpdating = True
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Einrücken eines Markierten Bereichs

Forumthread: Einrücken eines Markierten Bereichs

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread