1. #1
    Forzaracing's Avatar
    Registered
    10/04/09
    Location
    Genk
    Posts
    2,300
    iTrader
    99 (100%)
    Mentioned
    3 Post(s)
    Reputation
    0/13

    [Macro's voor Dummies] help!

    Hey iedereen,

    Voor mijn thesis moet ik heel wat excel files bewerken, eigenlijk transformeren, heel veel kolommen omzetten in rijen, enz.
    Nu bedacht ik mij dat dit normaal wel snel moet gaan met macro's maar laat mij daar nu net niet zoveel van snappen.

    Sub Transformeren()
    '
    ' Transformeren Macro
    '

    '
    Range("AD23:AH23").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=6
    Windows("transform.xlsx").Activate
    Range("D107").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    ActiveWindow.SmallScroll Down:=9
    End Sub
    Dit is eigenlijk wat ik moet doen, in een file gegevens in een rij selecteren en plakken in een kolom. Volgende rij opnieuw en die moet geplakt worden in een kolom onder de gegevens van de vorige rij.
    Nu deze macro doet het wel voor de cel die ik zelf doe maar gaat niet verder.

    Iemand een idee, u zou mij echt uren kunnen besparen.

    Heel veel dank op voorhand
    no votes  

  2. #2
    grafzerkpisser's Avatar
    Registered
    27/09/11
    Location
    Grimbergen
    Posts
    563
    iTrader
    40 (100%)
    Mentioned
    0 Post(s)
    Reputation
    0/7
    Is het zo iets? data1 a
    data1 b
    data1 c
    data2 w
    data2 s
    data3 d
    data3 q
    data3 a
    data3 b
    data4 a
    data5 g
    data5 e
    data5 k
    data5 d
    data5 j
    data5 l

    Omzetten naar:
    -----------------
    data1 a b c
    data2 w s
    data3 d q a b
    data4 a
    data5 g e k d j l


    Zo ja:
    Code:
    Sub  TransposeData()
       Dim rFrom As Range
       Dim rTo As Range
       Dim iRows As Integer
       Set rFrom = ActiveSheet.Range("A1")  ' assumes data starts at A1 on active sheet
       Set rTo = ActiveWorkbook.Worksheets.Add.Range("A1")
       Do Until IsEmpty(rFrom.Value)
         iRows = 1
         Do While rFrom.Value = rFrom.Offset(iRows).Value
           iRows = iRows+1
         Loop
         rTo.Value = rFrom.Value
         rTo.Offset(,1).Resize(,iRows) = Application.Transpose(rFrom.Offset(,1).Resize(iRows))
         Set rFrom=rFrom.Offset(iRows)
         Set rTo=rTo.Offset(1)
       Loop
     End Sub
    None are more hopelessly enslaved than those who falsely believe they are free.
    no votes  

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Log in

Log in