Excel, slim cellen verplaatsen.

[Withaar]

Ik heb een excel bestand met circa 20.000 gevulde cellen.
De waarden staan globaal in rij 1 t/m 250 en kolom A t/m circa FO.
Nu zou ik graag cel waarden waarin een @ voorkomt verplaatsen naar één kolom op Blad2. N.b. er komen ook lege cellen voor in deze matrix.

Iemand een idee voor een eenvoudige VBA oplossing?

N.b. alle cellen in één rij zetten zou ook al veel helpen.

 

[Wigi]

Tot welke code ben je al gekomen?

 

[Withaar]

Ben er al uit ergens een macro gevonden met Transpose tot A die na een kleine aanpassing al het werk no time voor me deed.

Sub TransposeallesnaarA()
' Kopieer alle cellen naar de A-kolom
Dim LRij As Long, Teller As Long, i As Long
' Zorg er voor dat er geen data in de A kolom staat.
' Maar even geen scherm update -> veel sneller.
Application.ScreenUpdating = False
' Zoek laatste rij in B kolom
LRij = Range("B" & Rows.Count).End(xlUp).Row
Teller = 1
    For i = 1 To LRij
' Alles van kolom B t/m IV
        Range("B" & i, "IV" & i).Copy
        Range("A" & Teller).PasteSpecial xlPasteValues, Transpose:=True
        Teller = Range("A" & Rows.Count).End(xlUp).Row + 1
    Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
Range("A1").Select
End Sub

 

[snb]

of

Sub mailadressen()
  With Blad1.UsedRange
    For j = 1 To .Rows.Count
      c0 = c0 & Join(Filter(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Rows(j))), "@"), "|") & "|"
    Next
  End With
  sq = Split(c0, "|")
  Blad1.Cells(1, 15).Resize(UBound(sq)) = WorksheetFunction.Transpose(sq)
End Sub