Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:59:21
23.04.2024 14:47:39
23.04.2024 14:23:45
Anzeige
Archiv - Navigation
340to344
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
340to344
340to344
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige