Lösung mit Schleife?

Forumthread: Lösung mit Schleife?

18.01.2005 12:49:36

Matthias

Hallo,
meine Problem ist folgendes:
Dieser Quellcode soll sich 20 mal wiederholen aber statt Range("J336:U341") soll 13 Zeilen tiefer ("J349:U354")die Werte kopiert und hinter den anderen Werten also ("Matrix") Range("J14") genommen werden. Dann fängt es wieder von vorne an, statt ("J349:U354") nun ("J362:U367")usw.


Sub FaktorprämieGesamt()
Sheets("Inputdaten").Select
Range("J336:U341").Select
Selection.Copy
Sheets("Matrix").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Sheets("Inputdaten").Select
End Sub

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Lösung mit Schleife?

Uduuh
AW: Lösung mit Schleife?

Harald
AW: Lösung mit Schleife?

18.01.2005 13:08:54

Josef
Syntaxfehler

18.01.2005 13:51:29

Matthias
Danke es funktioniert

18.01.2005 13:55:04

Matthias
AW: Danke es funktioniert

18.01.2005 13:56:51

Josef

AW: Lösung mit Schleife?

Uduuh

Hallo,
etwa so:
dim i as integer
for i=0 to 19
sheets("inputdaten").Range("J" &336+i*13 &":U" &341+i*13).copy
sheets("Matrix").Range("J" &2+i*13).pastespecial paste:=xlvalues
next i
Gruß aus'm Pott
Udo

AW: Lösung mit Schleife?

Harald

Hallo Matthias,
wenn ich mich nicht mit den Indizes vertan habe, könnte das funktionieren:
Option Explicit


Sub FaktorprämieGesamt()
Dim i As Integer
For i = 0 To 19
Sheets("Inputdaten").Select
Range("J" & 336 + 13 * i & ":U" & 341 + 13 * i).Select
Selection.Copy
Sheets("Matrix").Select
Range("J" & 2 + i * 13).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Next
Sheets("Inputdaten").Select
End Sub

Gruß Harald

AW: Lösung mit Schleife?

18.01.2005 13:08:54

Josef

Hallo Matthias!
Ungetestet, sollte aber funzen!

Option Explicit
Sub FaktorprämieGesamt()
Dim wksI As Worksheet, wksM As Worksheet
Dim lRow As Long, lastRow As Long
Set wksI = Sheets("Inputdaten")
Set wksM = Sheets("Matrix")
lRow = 336
With wksI
   Do

      lastRow = IIf(wksM.Range("J65536") <> "", 65536, _
      wksM.Range("J65536").End(xlUp).Row) + 1
      If lastRow < 2 Then lastRow = 2

      .Range(.Cells(lRow, 10), .Cells(lRow + 5, 21)).Copy

      wksM.Cells(lastRow, 10).PasteSpecial xlPasteValues

      lRow = lRow + 13

   Loop While lRow < 596
End With
Application.CutCopyMode = False
End Sub

Gruß Sepp

Syntaxfehler

18.01.2005 13:51:29

Matthias

Danke, erst einmal
bei deinem Code wird ein Sytaxfehler angezeigt. Ich habe die Lösung aber jetzt. Danke

Danke es funktioniert

18.01.2005 13:55:04

Matthias

Danke an die drei Herrschaften.
AW1: hatte einen Sytaxfehler angezeigt
AW2: hat nach jeder 13te Zeile eine Leerzeile eingefügt
AW3: die Daten wurden nicht transponiert
Habe AW3 verwendet mit dem Zusatz, das Daten auch transponiert werden:


Sub test()
Dim wksI As Worksheet, wksM As Worksheet
Dim lRow As Long, lastRow As Long
Set wksI = Sheets("Inputdaten")
Set wksM = Sheets("Matrix")
lRow = 336
With wksI
Do
lastRow = IIf(wksM.Range("J65536") <> "", 65536, _
wksM.Range("J65536").End(xlUp).Row) + 1
If lastRow < 2 Then lastRow = 2
.Range(.Cells(lRow, 10), .Cells(lRow + 5, 21)).Copy
wksM.Cells(lastRow, 10).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
lRow = lRow + 13
Loop While lRow < 596
End With
Application.CutCopyMode = False
End Sub

AW: Danke es funktioniert

18.01.2005 13:56:51

Josef

Hallo Matthias!
Das mit "Transpose:=True" hatte ich übersehen, Sorry ;-)
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Forumthread: Lösung mit Schleife?

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread