Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
920to924
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
920to924
920to924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

2 For-Schleifen kopieren von A nach B

2 For-Schleifen kopieren von A nach B
04.11.2007 15:49:56
A
Hallo zusammen,
ich benötige Hilfe für folgendes Makro. Es soll in Tabelle A die Spalte F durchlaufen und überprüfen, ob deren Wert >0 ist. Wenn ja sollen weitere Werte aus dieser Zeile, Zelle für Zelle in den Zielbereich der Tabelle B kopiert werden und anschliessend soll die Schleife in Tabelle A weiterlaufen, bis zum nächsten Wert >0 in Spalte F. Danach sollen in Tabelle B, in die darauffolgende Zeile die Werte eingefügt werden usw.
Nun funktioniert das Makro soweit, dass es in Tabelle A, die richtigen Zellen kopiert, aber ab der zweiten
Zeile in Tabelle B funk werden die Schleifen nicht korrekt durchlaufen.
Ich wäre sehr dankbar für Eure Hilfe, da ich leider nicht mehr weiterkomme.
Hier ist das Makro. Meine Bsp-Datei habe ich auch upgeloadet.
https://www.herber.de/bbs/user/47404.xls
Besten Dank im voraus für Eure Hilfe.

Sub KopiereAnachB()
'Hinweis Cells.Select Befehle habe ich eingefügt, um beim Debuggen eine visuelle Kontrolle zu  _
haben
'Set Variables and Status Notice
Application.StatusBar = "Achtung! - Makro läuft"
Sheets("A").Select
Dim row As Range
Dim x As Integer
Dim xy As Integer
Dim rng As Range
Dim i As Integer, counter As Integer
Dim LetzteZeile As Integer
'Set the range to evaluate to rng. Innerhalb dieser Range wird geprüft, ob ein Wert >0  _
vorhanden ist.
Set rng = Range("F1:F156")
'initialize i to 1
i = 1
'Loop for a count of 1 to the number of rows
'in the range that you want to evaluate.
For counter = 1 To rng.Rows.Count
'Wenn die Zelle den Wert >0 hat Wert kopieren,
'sonst springe zur nächsten Zeile Werte i +1
extern:
i = i + 1
Sheets("A").Select
If rng.Cells(i) > "0" Then
rng.Cells(i, 1).Select
rng.Cells(i, 1).Copy
'Ermittele die nächste freie Zeile für den Bereich Zeile 28 bis 44
Set row = Range("A28:A44")
x = 28
For xy = 1 To row.Rows.Count
'Wenn im Zieltabellenblatt der Wert für die Zelle leer ist füge den Wert aus Tabelle A ein
'Diese Wenn-abfrage ist für den Zielbereich und kopiert die Werte von A nach B
'Nachdem die 5 Werte wie im folgenden kopiert werden, soll für den Zielbereich in Tabelle B
'der Zeilenzähler +1 erhöht werden.
If IsEmpty(row.Cells(x, 6)) = True Then
Sheets("B").Select
LetzteZeile = Cells(Cells.Rows.Count, 3).End(xlUp).row
With Sheets("B") 'Namen anpassen
.Cells(LetzteZeile + 1, 1) = Cells(x, 4).Select
.Paste
Sheets("A").Select
rng.Cells(i, 0).Select
rng.Cells(i, 0).Copy
Sheets("B").Select
LetzteZeile = Cells(Cells.Rows.Count, 3).End(xlUp).row
With Sheets("B") 'Namen anpassen
.Cells(LetzteZeile + 1, 1) = Cells(x, 5).Select
.Paste
Sheets("A").Select
rng.Cells(i, -2).Select
rng.Cells(i, -2).Copy
Sheets("B").Select
LetzteZeile = Cells(Cells.Rows.Count, 3).End(xlUp).row
With Sheets("B") 'Namen anpassen
.Cells(LetzteZeile + 1, 1) = Cells(x, 3).Select
.Paste
Sheets("A").Select
rng.Cells(i, -3).Select
rng.Cells(i, -3).Copy
Sheets("B").Select
LetzteZeile = Cells(Cells.Rows.Count, 3).End(xlUp).row
With Sheets("B") 'Namen anpassen
.Cells(LetzteZeile + 1, 1) = Cells(x, 2).Select
.Paste
Sheets("A").Select
rng.Cells(i, -4).Select
rng.Cells(i, -4).Copy
Sheets("B").Select
LetzteZeile = Cells(Cells.Rows.Count, 3).End(xlUp).row
With Sheets("B") 'Namen anpassen
.Cells(LetzteZeile + 1, 1) = Cells(x, 6).Select
.Paste
' x = row.Rows.Count
End With
End With
End With
End With
End With
'Werte wurden kopiert, nun erhöhe den Zeilenzähler +1 und gehe zur nächsten Schleife in Tabelle  _
A
xy = xy + 1
x = x + 1
'Ab hier habe ich nun die Probleme, wenn das Makro die Schleife in Tabelle A für den Wert i  _
beginnt und dann
'aufgrund der If-Bedingung in Tabelle B mit Wert x weiterläuft, springt die Schleife entweder  _
nur noch im Zielbereich
'B weiter und dadurch läuft dann die Schleife in für A nicht mehr korrekt. Mit Goto habe konnte  _
ich das Problem leider nicht lösen.
'GoTo extern
Else
x = x + 1
End If
Next
i = i + 1
Sheets("A").Select
Else
i = i + 1
End If
Next
Application.StatusBar = ""
End Sub


Viele Grüsse
Frank

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2 For-Schleifen kopieren von A nach B
04.11.2007 16:32:22
A
Hallo
ich hab jetzt keine Lust, deinen Code auf Fehler zu analysieren, aber ausgehend von der Tatsache, das in gefilterten Tabellen beim Kopieren nur die Sichtbaren Werte kopiert werden, scheint mir dieses Makro hier einfacher und effektiver zu sein:

Sub KopiereAnachBneu()
Dim shZiel As Worksheet
Dim shQuelle As Worksheet
Dim rngZiel As Range
Dim rngQuelle As Range
Set shZiel = Sheets("B")
Set shQuelle = Sheets("A")
Set rngZiel = shZiel.Range("A28:F44")
Set rngQuelle = shQuelle.Cells(1, 1).CurrentRegion.Offset(1, 0)
Set rngQuelle = rngQuelle.Resize(rngQuelle.Rows.Count - 1)
rngZiel.ClearContents
shQuelle.Cells(1, 1).AutoFilter Field:=6, Criteria1:=">0"
If rngQuelle.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > rngZiel.Rows.Count Then
MsgBox "zu viele Zeilen, Werte können nicht kopiert werden."
Else
rngQuelle.Columns(1).SpecialCells(xlCellTypeVisible).Copy
rngZiel.Cells(1, 6).PasteSpecial xlPasteValues
rngQuelle.Columns(2).SpecialCells(xlCellTypeVisible).Copy
rngZiel.Cells(1, 2).PasteSpecial xlPasteValuesAndNumberFormats
rngQuelle.Columns(3).SpecialCells(xlCellTypeVisible).Copy
rngZiel.Cells(1, 3).PasteSpecial xlPasteValues
rngQuelle.Columns(5).SpecialCells(xlCellTypeVisible).Copy
rngZiel.Cells(1, 5).PasteSpecial xlPasteValues
rngQuelle.Columns(6).SpecialCells(xlCellTypeVisible).Copy
rngZiel.Cells(1, 4).PasteSpecial xlPasteValues
End If
shQuelle.Cells(1, 1).AutoFilter
End Sub


Gruß, Daniel

Anzeige
AW: 2 For-Schleifen kopieren von A nach B
04.11.2007 20:49:46
A
Hallo Daniel,
vielen Dank für Deine schnelle Hilfe. Ich habe es ausprobiert und es funktioniert perfekt. :-) Wow.
Wenn ich meinen Code im Nachhinein und im Vgl. ansehe, wird mir selber schlecht :-I. Eine Fehleranalyse
macht hier wirklich wenig Sinn.
Ich denke, ich könnte einen generellen Literaturtipp zum Einstieg gebrauchen.
Meine bisherigen Kenntnisse basieren auf dem bisschen VBA, dass im Excel-Kompendium 2003 von
M&T steht und ein wenig vom ausprobieren.
Ein Buch, dass einem als Laie einen gut strukturierten Selbsteinstieg gibt, wäre da wohl das richtige. :-)
Du hast mir nicht rein zufällig noch einen Literaturtipp?
Gruss,
Frank
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige