Wiederholungsschleife

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Wiederholungsschleife
von: Mascha
Geschrieben am: 19.11.2003 17:09:26

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
Bild


Betrifft: AW: Wiederholungsschleife
von: Claus Ohlendorf
Geschrieben am: 19.11.2003 17:36:39

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


Bild


Betrifft: AW: Wiederholungsschleife
von: OliveR
Geschrieben am: 19.11.2003 17:45:35

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



Bild


Betrifft: Danke!
von: Mascha
Geschrieben am: 20.11.2003 11:38:35

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


Bild

Beiträge aus den Excel-Beispielen zum Thema " Neue zeilen"