Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1308to1312
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
Inhaltsverzeichnis

verschachtelte Schleife

verschachtelte Schleife
02.05.2013 15:25:34
reinhardt
Hallo,
in TB1 stehen Werte (in Spalte A,B und C) in 65 Zeilen
in TB2 stehen Werte (in Spalte A und B )in 149 Zeilen
Ich breche mir einen ab, um folgende Liste zu erstellen:
1. Arbeitsgang:
TB1 erste Zeile kopieren in TB3.
In TB3 Zeile 1 Spalte D alle Werte aus TB2,Spalte A u B (149 Zeilen)kopieren.
Dann Autoausfüllen der Spalte A und B.
2. bis 65. Arbeitsgang:
das ganze Wiederholen.
Ich hoffe, das ist einigermaßen Verständlich.
Ich brauche eine Liste in TB3 mit den 65 Überschriften aus TB1, jeweils gepaart mit allen Werten aus TB2 (149 Zeilen)
Meine Schleifenversuche kann ich nur mit dem Taskmanager stoppen!
Wer kann mir bitte helfen?
Gruß
Reinhardt

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Beispielmappe? owT
02.05.2013 15:44:49
Rudi

Geht nur von Zuhause :(
02.05.2013 15:49:32
Zuhause
.

AW: Geht nur von Zuhause :(
02.05.2013 16:42:39
Zuhause
Hallo Rheinhard,
folgendes Makro solltest es tun, wobei die letzte Datenzeile in Blatt1 und Blatt2 in Spalte A automatisch ermittelt wird.
Hier kannst du natürlich auch jeweils feste Werte vorgeben.
Gruß
Franz
Sub Copy_nach_TB3()
Dim wksTB1 As Worksheet, wksTB2 As Worksheet, wksTB3 As Worksheet
Dim rngCopy As Range
Dim Zeile_1 As Long, Zeile_3 As Long
Set wksTB1 = ActiveWorkbook.Worksheets("TB1")
Set wksTB2 = ActiveWorkbook.Worksheets("TB2")
Set wksTB3 = ActiveWorkbook.Worksheets("TB3")
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Altdaten löschen
With wksTB3
.UsedRange.ClearContents
End With
'zu kopierender Bereich in TB2
With wksTB2
Set rngCopy = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
'    'Set rngCopy = .Range(.Cells(1, 1), .Cells(149, 2))
End With
'Daten kopieren von TB1 und TB2 nach TB3
With wksTB1
Zeile_3 = 1 'Startzeile für Einfügen in TB3
For Zeile_1 = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row '65
'Daten kopieren von TB1 nach TB3
.Range(.Cells(Zeile_1, 1), .Cells(Zeile_1, 3)).Copy _
Destination:=wksTB3.Range(wksTB3.Cells(Zeile_3, 1), wksTB3.Cells(Zeile_3 + _
rngCopy.Rows.Count - 1, 3))
'Daten kopieren von TB2 nach TB3
rngCopy.Copy wksTB3.Cells(Zeile_3, 4)
'nächste Einfügezeile
Zeile_3 = Zeile_3 + rngCopy.Rows.Count
Application.CutCopyMode = False
Next Zeile_1
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Anzeige
Vielen,vielen Dank!! o.T.
03.05.2013 07:40:34
reinhardt
.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige