Rækker til kolonner

prøv at spørge hjælpen efter TRANSPONER
Jeg mener at det er den funktion du skal bruge

Du kan tage dem enkeltvis, ved at kopiere oplysningerne og derefter indsætte dem med Indsæt Speciel-funktionen og i dialogboksen vælge Transponer.

Jeg kender desværre ingen metode, hvormed du kan ordne dem allesammen samtidig :o(

Prøv:

Marker/klip|kopier - flyt markør til ny placering - rediger/indsæt speciel/transponer

Det er transponer der skal bruges - jeg kan bare ikke få det til at virke :-(

hvis dine adr. er i kolonne A

=INDIREKTE("A"&KOLONNE()-1)

træk i fyldhåndtag til højre

fik lige nærlæst supertekst elegante forslag som virker fint
se bort fra mit indlæg :-)

Her vil det ikke virke .. Den skriver at de markerede områder har forskellige størrelser hvilket de ikke har ..

Jeg vil lige uddybe at de står rækkevis sådan her :

1
Egon Jensen
Hurragade 17
6588 Jubelby

1
Egon Jensen
Hurragade 17
6588 Jubelby

1
Egon Jensen
Hurragade 17
6588 Jubelby

Etc.

Marker den første persons data og kopier dem
Placer markøren i en tom celle, fx b1 og vælg Rediger, Indsæt speciel, Transponer
Fortsæt med de næste på samme måde

Transponer virker kun til tomme celler....

Det virker .. Jeg ved godt det er at stramme elastikken - men mon man kan lave en makro der kan klare det ?

Måske kan du klare det med en lille udbygning af exclents formel.
Hvis data starter i A1 (det første 1-tal)
Indsæt i kol. B og kopier hen og ned

=INDIREKTE("A"&5*RÆKKE(1:1)-5+KOLONNE())

Kode:

Først vælges 1. celle i inputområdet, dernæst 1. celle i outputområdet

Sub TransposeData()
Dim EntireRange        As Range
Dim rgFirstcellIN      As Range
Dim rgFirstCellOUT      As Range
Dim rg1                As Range
Dim x                  As Long
Dim y                  As Long

Set rgFirstcellIN = Application.InputBox("Select 1. cell for Datainput ", , , , , , , 8)
Set rgFirstCellOUT = Application.InputBox("Select 1. cell for Dataoutput", , , , , , , 8)
Set EntireRange = Range(rgFirstcellIN, Cells(65536, rgFirstcellIN.Column).End(xlUp))
x = 2
While x < EntireRange.Cells.Count
    Set rg1 = Range(Cells(x, 1), Cells(x, 1).End(xlDown))
    y = y + 1
    rgFirstCellOUT(y, 1).Resize(, rg1.Cells.Count) = Application.Transpose(rg1)
    x = rg1.End(xlDown).Row + 2
Wend
End Sub

Svar