Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Wiederholungsschleife

Forumthread: Wiederholungsschleife

Wiederholungsschleife
19.11.2003 17:09:26
Mascha
Hallo,

ich möchte für jede Zelle von Spalte G, die eine 2 enthält, die Zellen A bis G in die darunter liegende Zeile kopieren. Die Prozedur habe ich, glaube ich, von hier:

Cells.Find(What:="2", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Range(Selection, Selection.Offset(0, -6)).Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:G2"), Type:=xlFillCopy

Funktioniert. Aber wie kriege ich das hin, dass mein Makro diese Prozedur für jede 2 in Spalte G wiederholt (dann könnte ich mir Cells.Find... sparen)?

Ich habe es so probiert:


Sub Kopieren()
Dim zelle As Object
Dim Inhalt As String
Columns("G:G").Select
For Each zelle In Selection
If zelle.Value = 2 Then
Range(zelle, zelle.Offset(0, -6)).Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:G2"), Type:=xlFillCopy
End If
Next zelle
End Sub


Aber dann kopiert das Makro die erste Zeile immer weiter, bis ich unterbreche.

Kann mir jemand helfen?

Vielen Dank im voraus.

Gruß

Mascha
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wiederholungsschleife
19.11.2003 17:36:39
Claus Ohlendorf
Hmmm... Kopier doch die Spalte G in eine neue Spalte, und jede gefundene 2 in der Neuen Spalte kannst Du ja dann loeschen (ohne dass sie in der Originalspalte geloescht wird...)

Claus
AW: Wiederholungsschleife
19.11.2003 17:45:35
OliveR
Hallo Mascha,

so könnts gehen.
Gruß
OliveR

Option Explicit

Sub kopieren()
Dim i%, spalte%, lR%
spalte = InputBox("Bitte Spaltennummer eingeben.")
If spalte = Empty Then
Exit Sub
Else
lR = Cells(Rows.Count, spalte).End(xlUp).Row
For i = 1 To lR Step 1
If Cells(i, spalte) = 2 Then
Cells(i + 1, 1).EntireRow.Insert
Range(Cells(i, 1), Cells(i, 7)).Copy Range(Cells(i + 1, 1), Cells(i + 1, 7))
i = i + 1
lR = lR + 1
End If
Next i
End If
End Sub

Anzeige
Danke!
20.11.2003 11:38:35
Mascha
Mensch, super, OliveR!

Habe es noch ein bißchen nach meinen Bedürfnissen angepasst, aber ansonsten ist es genau, wonach ich gesucht habe, spart mir echt eine Menge Zeit!

Vielen Dank noch mal.

Mascha

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige