Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
788to792
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
788to792
788to792
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro zum Zählen von fettgedruckten Zeilen

Makro zum Zählen von fettgedruckten Zeilen
04.08.2006 10:55:19
fettgedruckten
Moin,
ich würde gerne eine Makro schreiben, die von mehreren Seiten in einer Datei alle fettgedruckten Zeilen auf eine neue Seite kopiert und sie dann nach Datum sortiert.
Wäre das möglich? Und wenn ja, wie?
Danke!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro zum Zählen von fettgedruckten Zeilen
04.08.2006 11:28:11
fettgedruckten
Hallo,
so:

Sub FetteKopierenUndSortieren()
Dim i As Long
Dim j As Long
j = 1
With Sheets(1)
For i = 1 To .Cells(65536, 1).End(xlUp).Row
If .Cells(i, 1).Font.Bold Then
Sheets(2).Cells(j, 1).Value = .Cells(i, 1).Value
j = j + 1
End If
Next i
End With
Sheets(2).Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Gruß
Bertram
AW: Makro zum Zählen von fettgedruckten Zeilen
04.08.2006 15:12:48
fettgedruckten
Vielen Dank für Deine Hilfe. Eine Frage noch: Wie mache ich in der Formel deutlich, dass ich eine ganze Reihe rüberkopieren möchte (z.B. A1:A15, B1:B15, etc.)? Und wie kann ich noch weitere Tabellen mit in die Formel einbeziehen?
Vielen Dank nochmal!
Anzeige
AW: Makro zum Zählen von fettgedruckten Zeilen
05.08.2006 12:52:48
fettgedruckten
Hi,
habe den Code mal abgeändert, dass er immer Spalten 1-15 kopiert und anschließend sortiert.

Sub FetteKopierenUndSortieren()
Dim i As Long
Dim j As Long
j = 1
With Sheets(1)
For i = 1 To .Cells(65536, 1).End(xlUp).Row
If .Cells(i, 1).Font.Bold Then
.Range(Cells(i, 1), Cells(i, 15)).Copy Destination:=Sheets(2).Cells(j, 1)
j = j + 1
End If
Next i
End With
With Sheets(2)
.Activate
.Columns("A:O").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

Kannst du genauer beschreiben, was du mit den anderen Tabellen machen willst?
Gruß
Bertram
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige