Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 08:56:18
Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen
20.04.2024 07:57:54
Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
864to868
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
864to868
864to868
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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
Anzeige
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

Anzeige
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige