kein

Forumthread: kein

kein

29.04.2007 12:00:00

Michael

Hallo,
ich möchte mit einem Macro in einer Spalte alle Zellen, die größer als Null sind , sowie die Zellen in der jeweils rechts daneben liegenden Spalte selektieren, kopieren und dann in eine andere zweispaltige Tabelle einfügen. In der anderen Tabelle sollen die Werte von oben beginnend in die nächst freie Zeile eingefügt werden.
Hat jemand eine Lösung dafür?
MfG Susison

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: kein

29.04.2007 12:14:00

Worti
@Worti

29.04.2007 12:28:00

Josef
Danke für denTipp, du hast natürlich recht. oT

29.04.2007 13:26:00

Worti
AW: kein

29.04.2007 15:21:35

Michael
Kommentierte Lösung

29.04.2007 19:11:00

Worti

AW: kein

29.04.2007 12:14:00

Worti

Hallo Michael,
so zB.:


Sub til()
Dim c As Range, Bereich As Range
Dim firsttime As Boolean
firsttime = True
For Each c In Range("A1:A20")
If c.Value > 0 Then
If Not firsttime Then
Set Bereich = Union(Bereich, c, c.Offset(0, 1))
Else
Set Bereich = Union(c, c.Offset(0, 1))
firsttime = False
End If
End If
Next c
Bereich.Copy Destination:=Worksheets(2).Range("A" & _
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1)
Set Bereich = Nothing
End Sub

Gruß Worti

@Worti

29.04.2007 12:28:00

Josef

Hallo Worti,
ohne zusätzliche Variable und ohne Fehler bei keinen gefundenen Zellen.
Sub til()
Dim c As Range, Bereich As Range

For Each c In Range("A1:A20")
    If c.Value > 0 Then
        If Not Bereich Is Nothing Then
            Set Bereich = Union(Bereich, c, c.Offset(0, 1))
        Else
            Set Bereich = Union(c, c.Offset(0, 1))
        End If
    End If
Next

If Not Bereich Is Nothing Then _
    Bereich.Copy Destination:=Worksheets(2).Range("A" & _
    Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1)

Set Bereich = Nothing

End Sub

Gruß Sepp

Danke für denTipp, du hast natürlich recht. oT

29.04.2007 13:26:00

Worti

Gruß Worti

AW: kein

29.04.2007 15:21:35

Michael

Hallo Worti,
recht vielen Dank, ich habe das Macro ausprobiert, es funktioniert tadellos.
Jetzt sollte ich Anfänger blos noch die Verbesserung von Josef verstehen. Könnt Ihr mir das erklären?
Wofür steht eigentlich" If not firsttime then" oder "Set Bereich =Nothing".
Gruß Michael

Kommentierte Lösung

29.04.2007 19:11:00

Worti

Hallo Michael,
hier der Code mit Erläuterung:


Sub til()
'Deklaration deer Variablen
Dim c As Range, Bereich As Range
'Für jede Zelle im Bereich A1:a20  kannst du an deine Bedürfnisse anpassen
For Each c In Range("A1:A20")
'Wenn Wert der Zelle > 0
If c.Value > 0 Then
'Bereich ist nicht leer
If Not Bereich Is Nothing Then
Set Bereich = Union(Bereich, c, c.Offset(0, 1))
Else
'Bereich ist leer (beimersten Treffer)
Set Bereich = Union(c, c.Offset(0, 1))
End If
End If
Next
'Nur kopieren, wenn Zelllen da sind, die Bedingung erfüllen!
If Not Bereich Is Nothing Then _
Bereich.Copy Destination:=Worksheets(2).Range("A" & _
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1)
'Speicher wieder freigeben, gehört zum guten Programmierstil!
Set Bereich = Nothing
End Sub

Gruß Worti

Beliebteste Forumthreads (12 Monate)

Forumthread: kein

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread