Soort transponeren maar dan met een Macro

[Selo22]

Ik heb alle informatie onder elkaar maar ik moet ze als rij hebben

Zie bijlage in Kolom A staat hoe ik ze nu heb in Rij 1 en 2 (vanaf kolom F) zie je hoe ik ze dus wil hebben

Hij moet pas transponeren nadat je zelf opdracht naar geeft dus met druk op knopje bijv.

Het kan niet handmatig omdat elke keer er meer rijen zijn doordat er geen vaste spelers aantallen zijn

 

[Warme bakkertje]

Kan je hier iets mee ?

Mvg

Rudi

 

[Selo22]

Kan je hier iets mee ?

Mvg

Rudi

Nee helaas

hij moet van players beginnen en ended geeft einde aan die hoeft niet
en ze moeten onder elkaar zoals in voorbeeld

 

[Cobbe]

Gebruik deze code;

Sub transponeren()
begin = 1
For c = 1 To Range("A65000").End(xlUp).Row
If Cells(c, 1) = "Ended" Then
Range("A" & begin & ":A" & c).Copy
Range("F" & Range("F65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
begin = c + 2: c = c + 2
End If
Next
End Sub

Misschien dat het kukt.

Suc6, Cobbe

 

[snb]

of deze

Sub versie1()
  With Columns(1).Find("Ended")
    [F65500].End(xlUp).Offset(1).Resize(, .Row) = Application.WorksheetFunction.Transpose([A1].Resize(.Row))
  End With
End Sub

of deze

Sub versie2()
  [A1].Resize(Columns(1).Find("Ended").Row).Copy
  [F65500].End(xlUp).Offset(1).PasteSpecial , , , True
End Sub

 

[Selo22]

Gebruik deze code;

Sub transponeren()
begin = 1
For c = 1 To Range("A65000").End(xlUp).Row
If Cells(c, 1) = "Ended" Then
Range("A" & begin & ":A" & c).Copy
Range("F" & Range("F65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
begin = c + 2: c = c + 2
End If
Next
End Sub

Misschien dat het kukt.

Suc6, Cobbe

hij werkt

alleen hij moet bij rij 1 beginnen of beter gezegd hij moet beginnen bij een lege rij dus elke keer als ik weer iets in cel A1 plakt en macro gebruik moet ie transposen naar een lege cel waardoor je steeds kan updaten.

Is ook beter als het naar een andere blad wordt getransposed (?) blad2 bijv.

Misschien wordt het zo moeilijk maar is het mogelijk dat hij van onderen begint? zodat hij de onderste game als eerste pakt?

 

[Cobbe]

Gewoon omdraaien:

Sub transponeren()
begin = Range("A65000").End(xlUp).Row
For c = begin To 1 Step -1
If Cells(c, 1) = "Players" Then
Sheets("Blad1").Range("A" & c & ":A" & begin).Copy
Sheets("Blad2").Range("F" & Sheets("Blad2").Range("F65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
begin = c - 2: c = c - 2
End If
Next
End Sub

Mar die code van Snb is vele malen beter als de mijne maar ik krijg hem zo niet werkend.

Mvgr. Cobbe

 

[Selo22]

Gewoon omdraaien:

Sub transponeren()
begin = Range("A65000").End(xlUp).Row
For c = begin To 1 Step -1
If Cells(c, 1) = "Players" Then
Sheets("Blad1").Range("A" & c & ":A" & begin).Copy
Sheets("Blad2").Range("F" & Sheets("Blad2").Range("F65000").End(xlUp).Row + 1).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
begin = c - 2: c = c - 2
End If
Next
End Sub

Mar die code van Snb is vele malen beter als de mijne maar ik krijg hem zo niet werkend.

Mvgr. Cobbe

die van snb doet niet onder elkaar en pakt alleen 1 zo'n game