Clever-Excel-Forum

Ich möchte ein Pivottabelle bevorzügen.

Hallo,

@schauan: Jetzt habe ich folgendes Problem :(  [attachment=23931]

Hallöchen,

sorry, das End If muss etwas weiter runter, zwischen die beiden "Spungbefehle"

Also nicht

…
'Ende Wenn in der Folgezelle auch was steht, dann
End If
'Weiter zum Ende und dann zum n?chsten Anfang
'--> setzt min eine Leerzeile zwischen den Bereichen voraus
ActiveCell.End(xlDown).Activate
ActiveCell.End(xlDown).Activate
…

sondern

…
'Weiter zum Ende und dann zum n?chsten Anfang
'--> setzt min eine Leerzeile zwischen den Bereichen voraus
ActiveCell.End(xlDown).Activate
'Ende Wenn in der Folgezelle auch was steht, dann
End If
ActiveCell.End(xlDown).Activate
…

Wenn keine Daten kommen dann reicht ein ...xldown um zum nächsten Bereich zu kommen.

Hallo,

hier mit Datumsformatübertragung und Löschung der Ursprungszeilen:

Sub SenkWaag_Kuwer()
  Dim lngA As Long, lngZ As Long
  Application.ScreenUpdating = False
  'Zelle A2 aktivieren 
  Cells(2, 1).Activate
  'Ausführen solange in der aktiven Zelle was steht 
  Do While ActiveCell.Value <> ""
    If IsDate(ActiveCell.Offset(1).Value) Then
      'Im Bereich neben der aktiven Zelle 
      With ActiveCell.Offset(, 1).Resize(1, (ActiveCell.End(xlDown).Row - ActiveCell.Row) * 2)
        lngA = .Cells.Count
        For lngZ = lngA - 1 To 1 Step -2
          .Cells(lngZ).NumberFormat = ActiveCell.Offset(1).NumberFormat
          .Cells(lngZ).Resize(1, 2).Value = ActiveCell.Offset((lngA - lngZ) / 2 + 0.5).Resize(1, 2).Value
        Next lngZ
      End With
      Range(ActiveCell.Offset(1), ActiveCell.End(xlDown).Offset(1)).EntireRow.Delete
    Else
      ActiveCell.Offset(1).EntireRow.Delete
    End If
    'Weiter zum nächsten Anfang 
    ActiveCell.Offset(1).Activate
  'Ende Ausführen solange in der aktiven Zelle was steht 
  Loop
  'A2 aktivieren 
  Cells(2, 1).Activate
  Application.ScreenUpdating = True
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Gruß Uwe