Clever-Excel-Forum

Hi zusammen
Ich habe in meinem Arbeitsblatt "Start" Adressen welche ich in andere Zellen Verschieben möchte.
Es handelt sich um Adressen die leider immer in 4 Zellen untereinander unterteilt sind
Jetzt würde ich gerne diese Warte wie auf dem Bild kopieren..

Wie ist das möglich?

Ich habe mehrere Anläufe versucht und bin immer gescheitert Blush

Hier ein Versuch indem ich die Daten noch in ein anderes Arbeitsblatt kopiere..

Code:
Sub Makro3()

    For Counter = 1 To 20

    Set curCell = Worksheets("Start").Cells(Counter, 2)

    'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0

        Range(ActiveCell, Selection.End(xlDown)).Select

            Selection.Copy

            Sheets("Ziel").Select

            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

            Cells(NextRow, 1).Select

            'Cells(NextRow, 1).Select

            ActiveSheet.Paste

            Sheets("Start").Select

        Selection.End(xlDown).Select

        ActiveCell.Offset(2, 0).Select

    Next Counter

End Sub

Hallo

ohne VBA...

Tabelle1

	A	B	C	D
1	N1	N2	N3	N4
2	S1	S2	S3	S4
3	O1	O2	O3	O4
4	T1	T2	T3	T4
5
6	N2
7	S2
8	O2
9	T2
10
11	N3
12	S3
13	O3
14	T3
15
16	N4
17	S4
18	O4
19	T4

verwendete Formeln
Zelle	Formel	Bereich	N/A
B1: D4	=INDEX($A:$A;SPALTE()*5-5+ZEILE();1)

http://excel-inn.de/dateien/vba_beispiel..._addin.zip

http://Hajo-Excel.de/tools.htm

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 25.14 einschl. 64 Bit

LG UweD

Hallo,

per VBA z.B. so:

Code:
Sub aaa()

  Dim i As Long

  With Range(Cells(5, 1), Cells(Rows.Count, 1).End(xlUp))

    With .SpecialCells(xlCellTypeConstants)

      For i = 1 To .Areas.Count

        .Areas(i).Cut Cells(1, i + 1)

      Next i

    End With

    .Delete xlUp

  End With

End Sub

Gruß Uwe

Guten Morgen Uwe,

Der Fragesteller wollte den Code Tabellenübergreifend. Ich habe mir erlaubt das in deinem Code einzubauen. Nicht böse sein.

Microsoft Excel Objekt Tabelle1

Sub aaa() 
  Dim i As Long 
  With Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) 
    With .SpecialCells(xlCellTypeConstants) 
      For i = 1 To .Areas.Count 
        .Areas(i).Cut Sheets("Ziel").Cells(1, i + 1) 
      Next i 
    End With 
    .Delete xlUp 
  End With 
End Sub

Gruß
Marcus

Hallo Markus,

dann wäre aber noch zu klären, ob
- die Daten im Quellblatt dann auch gelöscht werden sollen
- das Zielblatt immer das Blatt "Ziel" sein soll
- im Zielblatt dann vielleicht in Spalte A begonnen werden sollte.

Gruß Uwe

Hallo Uwe,

ich dachte ich hätte da etwas falsch verstanden. Mich wundere schon dass Du ".Cut" nutzt. Ich hätte da wirklich Copy und Paste genutzt. Vielleicht klärt uns der TE da noch auf.

Gruß
Marcus

Zeichner

UweD

Kuwer

marose67

Kuwer

marose67

	A	B	C	D
1	N1	N2	N3	N4
2	S1	S2	S3	S4
3	O1	O2	O3	O4
4	T1	T2	T3	T4
5
6	N2
7	S2
8	O2
9	T2
10
11	N3
12	S3
13	O3
14	T3
15
16	N4
17	S4
18	O4
19	T4

	A	B	C	D
1	N1	N2	N3	N4
2	S1	S2	S3	S4
3	O1	O2	O3	O4
4	T1	T2	T3	T4
5
6	N2
7	S2
8	O2
9	T2
10
11	N3
12	S3
13	O3
14	T3
15
16	N4
17	S4
18	O4
19	T4

	A	B	C	D
1	N1	N2	N3	N4
2	S1	S2	S3	S4
3	O1	O2	O3	O4
4	T1	T2	T3	T4
5
6	N2
7	S2
8	O2
9	T2
10
11	N3
12	S3
13	O3
14	T3
15
16	N4
17	S4
18	O4
19	T4