Supportnet / Forum / Tabellenkalkulation

Hallo Community, versuch mich momentan erfolglos an folgendem Code: Sub Test() Dim i, Sheets("Tabelle1").Select Range("A1").Select For I = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1 Range(Cells(I, 1), Cells(I, 3)).Select Selection.Copy Sheets("Tabelle2").Activate Range("C3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True Sheets("Tabelle3").Activate [b]Range("A10").Value = Sheets("Tabelle2").Range("C3").Value Range("B10").Value = Sheets("Tabelle2").Range("C8").Value[/b] Sheets("Tabelle1").Select Next I End Sub Jetzt hab ich da leider ein Problem. Zur Erklärung: Der Code soll aus der Tabelle1 eine Schleife durchlaufen, in der Zellbereiche zeilenweise kopiert und der Wert dann in Tabelle2 übertragen wird. In der Tabelle2 wird dann ein weiterer Wert ermittelt (C8) der dann mit dem Wert aus C3 in die Tabelle 3 übernommen werden soll. Nun bekomm ich das mit einer weiteren Schleife nicht auf die Reihe. Der [b]fett[/b] markierte Bereich müsste auch über einen variablen Bereich (ab A10, bzw. B10 nach unten ergänzen) erhalten, da sonst A10 und B10 aufgrund des Schleifendurchlaufs nur den jeweils letzten Wert der Tabelle1 erhalten. Versucht hab ich schon, die Anzahl der Zellen (i) aus der Tabelle1 auszulesen, denn um die müsste die Tabelle3 ab A10 nach unten erweitert werden, hat aber leider nicht funktioniert. Vielleicht fällt jemand hierzu etwas ein ?! Viele Grüße martl

hi martl :)

versteh nur die haelfte,hab spontan mal umgestaltet,wie du siehst ohne selection,und deine zweite schleife mal als beispiel rangehangen,da ich nicht testen konnte,ist es hoechstens als beispiel aber nicht als loesung anzusehen.

gruss nighty

Sub test()
Dim i

Rem zugriff von der aktiven nach Tabelle2 dadurch bestimmt .BEFEHL aktive ohne vorangestellten punkt

With Worksheets("Tabelle2")
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
.Range(Cells(i, 1), Cells(i, 3)).Copy
Sheets("Tabelle2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Tabelle3").Activate
Range("A10").Value = .Range("C3").Value
Range("B10").Value = .Range("C8").Value
Next i
End With

Rem zugriff von der aktiven nach Tabelle3 dadurch bestimmt .BEFEHL/aktive ohne vorangestellten punkt

With Worksheets("Tabelle3")
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
Cells(i, 1).Value = .Range(i,3).Value
Cells(i, 2).Value = .Range(i,3).Value
Next i
End With
End Sub

hi martl :)

noch ein beispiel :)

Sub test1()

rem index fuer die tabellen,hier tabelle2 und tabelle3

For index1 = 2 To 3

With Worksheets(index1)

Rem index1 ist tabelle2

If index1 = 1 Then
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
Cells(i, 1).Value = .Range(i, 3).Value
Cells(i, 2).Value = .Range(i, 3).Value
Next i
End If

Rem index2 waere tabelle3

If index1 = 2 Then

End If
End With
Next index1
End Sub

hi martl :)

und noch eine schleifen variante mit festem bereich

gruss nighty

Sub test()
Dim rgBereich As Range
Dim SucheNach
Dim Zaehler1 As Range
SucheNach = ActiveCell.Value
Set rgBereich = Worksheets("Tabelle1").Range("E1:E3")
For Each Zaehler1 In rgBereich
If Zaehler1.Value = SucheNach Then
Zaehler1.Select
Exit For
End If
Next Zaehler1
End Sub

Hallo nighty,

vorab vielen herzlichen Dank für Deine Hilfe beim Aufbau des Codes. Leider bin ich was VBA angeht noch recht schwach auf den Füssen, aber dafür sollen die Codes schon gestern fertig sein ;). Hab Deine Codes mal ausprobiert, erhalte jedoch in den folgenden Zeilen (fett) eine Fehlermeldung:

Sub test()
Dim i

Rem zugriff von der aktiven nach Tabelle2 dadurch bestimmt .BEFEHL aktive ohne vorangestellten punkt

With Worksheets("Tabelle2")
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
.Range(Cells(i, 1), Cells(i, 3)).Copy
Sheets("Tabelle2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Tabelle3").Activate
Range("A10").Value = .Range("C3").Value
Range("B10").Value = .Range("C8").Value
Next i
End With

Rem zugriff von der aktiven nach Tabelle3 dadurch bestimmt .BEFEHL/aktive ohne vorangestellten punkt

Als Fehler wird angegeben: Anwendungs- oder objektdefinierter Fehler; Laufzeitfehler 1004. Kann ich durch den „Punkt“ auf die aktive Tabelle1 zugreifen ?. Hab das mit den Kommentaren in den Kommentarzeilen (REM) im Moment noch nicht so recht verstanden.

Bei meiner Problemschilderung hab ich mich etwas umständlich ausgedrückt. Daher nochmals ganz kurz eine Problemschilderung:

Tabelle 1: Flexibler Bereich, zeilenweise Auslesen des flexiblen Bereichs
Tabelle 2: Werte aus Tabelle1 in Tabelle 2 (transponiert) einfügen
Tabelle 3: Werte aus Tabelle 2 und zusätzlicher Wert in Tabelle 3 übernehmen

<SCHLEIFE> ->

Tabelle 1: Flexibler Bereich, zeilenweise Auslesen (jetzt 2. Zeile) des flexiblen
Bereichs
Tabelle 2: Werte aus Tabelle1 in Tabelle 2 (transponiert) einfügen
Tabelle 3: im Anschluss an die aus dem ersten Schleifendurchlauf eingefügten Werte
sollen nun die neuen Werte eingetragen werden.
<SCHLEIFE> ….

Würde mich sehr freuen, wenn Du Dir das nochmals anschauen könntest ?!

Viele Grüße
martl

hi martl :)

korrigiert

achte auf die syntax mit vorangestellten punkt,diese beziehen sich darauf

With Worksheets("Tabelle2")

die selbe syntax ohne punkt auf die aktive tabelle

gruss nighty


With Worksheets("Tabelle2")
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1

rem bezug Tabelle2
.Range(Cells(i, 1), Cells(i, 3)).Copy

rem bezug Tabelle2
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

rem Range("A10").Value waere die aktive
rem .Range("C3").Value waere auf Tabelle2 bezogen
Range("A10").Value = .Range("C3").Value

Range("B10").Value = .Range("C8").Value
Next i
End With

gruss nighty

hi martl :)

die copy zeile hat bezug zur tabelle2 ,ist das so gewollt,wenn nicht den vorangestellten punkt entfernen somit copyzeile bezug zur aktivenTabelle hat.

gruss nighty

Hi nighty,

nochmals Danke, dass Du Dir nochmals Zeit genommen hast, mir da auf die Sprünge zu helfen.
Jetzt hab ichs verstanden.
Zwischenzeitlich hab ich den Programmablauf wie folgt geändert:

For Tool1 = 4 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
Range(Cells(Tool1, 1), Cells(Tool1, 3)).Select
Selection.Copy
Sheets("Tabelle2").Activate
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Tabelle3").Activate
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Value = Sheets("Tabelle2").Range("C3").Value
ActiveCell.Offset(1, 1).Value = Sheets("Tabelle2").Range("C8").Value
Sheets("Tabelle1").Select
Next Tool1

... ist zwar ein bisschen getrickst, funktioniert aber. Also nochmals vielen Dank für Deine Unterstüzung

Viele Grüße und noch einen schönen Tag
martl

• VBA - Makros
• VBA und "-00"
• VBA
• VBA
• VBA