Anzeige
Archiv - Navigation
772to776
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
772to776
772to776
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

zelle kopieren bis zum nächsten Wert

zelle kopieren bis zum nächsten Wert
16.06.2006 11:28:53
Anton
Hallo Leute,
ich habe in Spalte A nur ab und zu einen Text stehen er beginnt immer mit "Application" dies sind meine Überschriften
In Spalte B habe ich massenweise Daten.
Ich möchte nun die Überschrift so lange nach unten kopieren wie die Zellen in Spalte A leer sind.
Danach das gleiche mit der nächsten Überschrift.
Hier mein bisheriger (fehlerhafter) Code:

Sub H_ApplicationNach_unten_Kopieren()
' "Application" bis zum nächsten "Application" runterkopieren
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = Lrow To 2 Step -1
If Cells(i, 1).Value Like "*Application*" Then
'Autofill aus Aufzeichnung:
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A26"), Type:=xlFillDefault
Range("A2:A26").Select
Range("C2").Select
'alter Kopierbefehl: Cells(i, 2) = Cells(i, 1).Value
End If
Next i
End Sub

Wer kann mir bitte weiterhelfen.
Ich dachte vielleicht auch an ein "Firstcell" und "Lastcell"
Funktioniert auch ein "End(xlDown).Row" damit Excel von oben nach unten arbeitet?
Und wie war das gleich wieder mit dem Datenende? Denn Excel soll ja kopieren bis Spalte B leer ist.
Mein Dank geht schon jetzt in Eure Richtung.
Servus,
Anton

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nachtrag
16.06.2006 11:42:10
Anton
Hallo Leute,
hab' mir mal einen Code zusammengebastelt,
den Ihr Profies bestimmt leicht korrigieren und zum laufen bringen könnt.

Sub H_ApplicationNach_unten_Kopieren()
' "Application" bis zum nächsten "Application" runterkopieren
Dim Lrow As Long, i As Long
Dim Firstcell As Integer
Dim Lastcell As Integer
Lrow = Cells(Rows.Count, 2).End(xlDown).Row
For i = Lrow To 2 Step -1
If Cells(i, 1).Value Like "*Application*" Then
Firstcell = Cells(i + 1, 1)
Lastcell = cells(next i -1, 1) 'Achtung diese Zeile ist knall-rot
Range(Firstcell, Lastcell) = Cells(i, 1).Value
End If
Next i
End Sub

Servus,
Anton
Anzeige
AW: Nachtrag
16.06.2006 11:54:18
Andi
Hi,
probier mal dies:

Sub t()
Dim zeile As Long
For zeile = 1 To Range("B65536").End(xlUp).Row
If Cells(zeile, 1).Value = "" Then Cells(zeile, 1).Value = Cells(zeile - 1, 1).Value
Next zeile
End Sub

Geht aber auch ganz ohne Makro:
tu mal in Spalte A in den Zellen mit Überschrift auf das kleine schwarze Quadrat doppelklicken (das mit dem man Formeln runterkopieren kann).
Schönen Gruß,
Andi
Herzlichen Dank
16.06.2006 12:19:05
Anton
Hallo Andi,
Herzlichen Dank.
Dein Makro ist ja richtig kurz.
Habe ich mir erstmal auf der Zunge zergehen lassen....
Servus,
Anton
Anzeige
Gern geschehen...
16.06.2006 13:05:15
Andi
Danke für die Rückmeldung.
Schönen Gruß,
Andi

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige