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

Makro zum Zählen von fettgedruckten Zeilen

Forumthread: 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!
Anzeige

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
Anzeige
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!
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)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige