Tabellenbereiche per VBA Verschachteln

[Angelina]

Damit Du dierekt in die erste Zeile Spalte GE schreibst, musst Du nur die Codezeile

Code:

fz = ws.Cells(Rows.Count, 187).End(xlUp).Row + 1

gegen diese ersetzen

Code:

fz = ws.Cells(Rows.Count, 187).End(xlUp).Row

Gruß
Max

hallo Max,

nein das geht eben nicht - dachte ich mir auch
wenn die +1 entfernt wird, dann schreibt er alle Zellen aus der Spalte A nach GE


hallo chris-ka,


das war die Endlösung von dir "Gott sei Dank"
Super gelöst von dir





Danke nochmals
LG
Angelina

[chris-ka]

Hi,

aber gerne Doch

Alternativ über Arrays

Code:

Sub Verschachteln()
  Dim ws As Worksheet, i As Long, fz As Long, r1 As Range, r2 As Range, r3 As Range, Index As Long
  Dim Arr1, Arr2, Arr3
  Set ws = ThisWorkbook.Worksheets("F")
  Set r1 = ws.Range("GG1:GG100")
  Set r2 = ws.Range("GF1:GF100")
  Set r3 = ws.Range("Ge1:Ge200")
  Arr1 = r1
  Arr2 = r2
  Arr3 = r3
  Index = 1
  With ws
      For i = 1 To UBound(Arr1)
           Arr3(Index, 1) = Arr1(i, 1)
           Arr3(Index + 1, 1) = Arr2(i, 1)
           Index = Index + 2
      Next
  End With
  r3.Value = Arr3
End Sub

Code ist zwar länger aber dafür schneller :)

[Max]

...
hallo Max,

nein das geht eben nicht - dachte ich mir auch
wenn die +1 entfernt wird, dann schreibt er alle Zellen aus der Spalte A nach GE

...

Jupp sorry,

das war quatsch.

Gruß
Max

[Angelina]

Hi,

aber gerne Doch

Alternativ über Arrays

Code:

Sub Verschachteln()
  Dim ws As Worksheet, i As Long, fz As Long, r1 As Range, r2 As Range, r3 As Range, Index As Long
  Dim Arr1, Arr2, Arr3
  Set ws = ThisWorkbook.Worksheets("F")
  Set r1 = ws.Range("GG1:GG100")
  Set r2 = ws.Range("GF1:GF100")
  Set r3 = ws.Range("Ge1:Ge200")
  Arr1 = r1
  Arr2 = r2
  Arr3 = r3
  Index = 1
  With ws
      For i = 1 To UBound(Arr1)
           Arr3(Index, 1) = Arr1(i, 1)
           Arr3(Index + 1, 1) = Arr2(i, 1)
           Index = Index + 2
      Next
  End With
  r3.Value = Arr3
End Sub

Code ist zwar länger aber dafür schneller :)

hallo,
ja - da geht die Post ab.

Nochmals danke für diese tolle Arbeit

LG
Angelina