Office: Simples Problem mit Kopieren von Zellinhalten und Schleife

Hi,
ich bin totaler Neuling in VBA und habe folgendes Problem:
Aus dieser Tabelle

dampf 58
husten 54


soll folgendes werden (siehe anhang):




Ich wollte das jetzt mit einer Schleife machen, da die Datei nicht nur aus den 2 Werten besteht sondern aus deutlich mehr.

Code:

Dim Zähler As Integer
Dim  As String
Sub test()
For Zähler = 1 To 500
Worksheets(1).Range("B1").Select
Selection.Copy
Range("E1:E4").Select
ActiveSheet.Paste


Worksheets(1).Range("A1").Select
Selection.Copy
Range("D1").Select

ActiveSheet.Paste
Next Zähler


End Sub

Da fängt es jetzt schon an, wie kann ich ihm sagen dass er mir bei jedem Durchlauf um eins nach unten springt beim Kopieren und die Range um 4 nacht unten setzt? Wäre für Hilfe sehr dankbar.[/list]

 

Hallo!

Code:

Sub xy()
Dim i As Long
For i = 1 To 100
Cells(4 * i - 3, 4) = Cells(i, 1)
Range(Cells(4 * i - 3, 5), Cells(4 * i, 5)) = Cells(i, 2)
Next i
End Sub

 

Hallo,

meinst Du Folgendes?

Code:

Option Explicit

Sub test1()
  Dim ZeileQ As Integer 'Nummer der Quellzeile
  Dim ZeileZ As Integer 'Nummer der Zielzeile
  ZeileZ = 1
  For ZeileQ = 1 To 2  'bzw. 500 (=Anzahl Quellzeilen) im Bereich A:B
    With Worksheets(1)
      .Cells(ZeileQ, 1).Copy Destination:=.Cells(ZeileZ, 4)
      .Cells(ZeileQ, 2).Copy Destination:=.Range(.Cells(ZeileZ, 5), .Cells(ZeileZ + 3, 5))
    End With
    ZeileZ = ZeileZ + 4
  Next ZeileQ
End Sub

 

Hi,

wenn die Anzahl je Eintrag unterschiedlich sein kann:

Code:

Sub Zusammenfassen()
    Dim loZeile As Long
    Dim loZeile2 As Long
    loZeile2 = 1
    For loZeile = 1 To IIf(IsEmpty(Cells(Rows.Count, 4)), Cells(Rows.Count, 4).End(xlUp).Row, Rows.Count)
        Cells(loZeile2, 1) = Cells(loZeile, 3)
        Cells(loZeile2, 2) = Cells(loZeile, 4)
        loZeile2 = loZeile2 + 1
        loZeile = Cells(loZeile, 3).End(xlDown).Row - 1
    Next loZeile
End Sub

Daten stehen in Spalte C und D ab Zeile 1, geschrieben wird in Spalte A und B ab Zeile 1.

Bis später,
Karin