VBA Copy and paste

[Zeichner]

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 
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

[UweD]

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

[Kuwer]

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

[marose67]

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

[Kuwer]

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

[marose67]

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