Thema: Schleife für Kopieren von Zellinhalten aus 12 Monatsblättern

Guten Tag an alle VBA-Gurus, Excel-Profis und Helfer in der Not,

je länger ich mit Excel arbeitet, desto mehr merke ich, wie wenig ich davon beherrsche. Daher suche ich heute euren Rat. Dieses Forum und Archiv sind so riesig, dass es vielleicht schon eine Lösung gibt, die ich nicht gefunden habe. Dann würde ich mich über einen Link dahin freuen.

Meine Datei: In einer Statistik-Mappe mit Arbeitsblättern pro Monat (01-12), einem Summenblatt für das ganze Jahr und 2 leeren Blättern für die zu erstellenden Listen, gibt es unter anderem die Zeilen "Zugänge", "Abgänge", "Vermittelt" und "Verstorben" (es handelt sich um Tiere). Die Zeilen enthalten in einer Zelle die Namen aller betreffenden Tiere, mit Kommata getrennt und daneben die Anzahl der Namen. Das Zählen der Namen hat schon mal geklappt (=WENN(ISTLEER(D40);0;LÄNGE(D40)-LÄNGE(WECHSELN(D40;",";""))+1)). Dank Copy+Paste.

Nun möchte ich je eine Namensliste für "Vermittelte" und "Verstorbene" in den leeren Blättern erstellen, wobei je ein Name unter dem anderen stehen soll. Ich kopiere also das entsprechende Feld (Feldnamen Verm01-Verm12 und Gest01-Gest12) in die erste leere Zeile, wandle "Text in Spalten" und transponiere dann die Spalten zu Zeilen. Das klappt noch ziemlich fehlerhaft mit dem ersten Monat (nur zwei Namen).

Ich wünsche mir eine Schleife, die alle Monatsblätter 01-12 der Reihe nach durchläuft und die Zelle Gest+Monat kopiert, so dass am Ende alles in Spalte A untereinander steht.
Das Makro soll eine zuvor erstellte Liste löschen und im leeren Blatt neu beginnen. Ich möchte keine neues Blatt erstellen, da alle Blätter Namen haben.

Was ich bisher zusammengeschustert habe:

Sub ListeVerstorben()
Application.ScreenUpdating = False

'Spalte leeren
Sheets("Verstorben").Range("A:A").ClearContents
Range("A1").Select
z = Range("A65536").End(xlUp).Row + 1

'Beginn Schleife Alle Monate

'Zelle kopieren und anfügen
Application.Goto Reference:="Gest01"
Selection.Copy ' oder kürzer Range("Gest01").Copy ?

Sheets("Verstorben").Select
Cells(z, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False

'Text in Spalten
Selection.TextToColumns Destination:=Application.ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'(Die kopierte Zelle enthielt nur 2 Namen. Ich bräuchte eher ein flexibles Array.)

'Transponieren
'x = Range("A65536").End(xlUp).Column
Selection.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Cells(z + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False

'TransSpalten löschen
Range("B:B").End(xlToRight).Select
'Selection.ClearContents

'Ende Schleife (Und dann ist plötzlich die ganze Liste wieder weg.)


'Blatt formatieren
Cells.Select
With Selection
Call LinienLöschen '(funktioniert nicht)
'Selection.Borders(xlEdgeLeft).LineStyle = xlNone
'Selection.Borders(xlEdgeTop).LineStyle = xlNone
'Selection.Borders(xlEdgeBottom).LineStyle = xlNone
'Selection.Borders(xlEdgeRight).LineStyle = xlNone
'Selection.Borders(xlInsideVertical).LineStyle = xlNone
'Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Call FontArial10
End With

'Alphabetisch sortieren
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select

End Sub

sowie:
Sub FontArial10()
'Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A2").Select
End Sub
Sub LinienLöschen()
'Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
End Sub

Die Listen-Blätter sind mit Bedingter Formatierung versehen, so dass Dubletten ins Auge fallen (Formel: =ZÄHLENWENN(A:A;A1)>1). Das i-Tüpfelchen wäre dann noch eine Schaltfläche mit Makro, das die Dubletten rauslöscht, nachdem wir das nochmal kontrolliert haben. Die Listen brauchen keine Überschrift. Sie werden zu Word kopiert und dort in Spalten formatiert.

Wenn das gar nicht verständlich ist, kann ich auch eine abgespeckte Datei hochladen.

Ihr würdet mir und dem Tierschutz wirklich sehr helfen. Tausend Dank fürs Lesen und Tüfteln.

Hi,

ich finde immer, es ist besser, per Upload eine Bsp-Datei mit genügend Bsp-Daten UND einem per Hand gezeigtem Wunschergebnis zu zeigen.
a) mit Datei sieht man, was der Fragende möchte
b) mit Datei können Antworter auch testen
c) ohne Datei ist die Interpretationsfreiheit bei Beschreibungen zu groß, das man einfach zu viel falsch verstehen könnte

Ciao
Thorsten

Hier ist meine abgespeckte Datei mit den relevanten Daten:
https://www.herber.de/bbs/user/173671.xls
Toll, die schnelle Reaktion! Danke

Moin

Sub Unit()



    Dim lngZeile As Long, rngLoeschen As Range

        

    

    For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

        If WorksheetFunction.CountIf(Cells(1, 1).Resize(lngZeile, 1), Cells(lngZeile, 1)) > 1 Then

           If rngLoeschen Is Nothing Then

                Set rngLoeschen = Cells(lngZeile, 1)

           Else

                Set rngLoeschen = Union(rngLoeschen, Cells(lngZeile, 1))

           End If

        End If

    Next

    

    If Not rngLoeschen Is Nothing Then

        rngLoeschen.Delete

        Set rngLoeschen = Nothing

    End If





End Sub

In Excel-VBA sollte man den Code zwecks Beschleunigung i.d.R. ohne Select u. Selection schreiben.
Gruß Gerd

Hallo

wuuf, wuuf, miau, miau ...
Ihr würdet mir und dem Tierschutz wirklich sehr helfen

Netter Thread, nette Bitte, ist bei mir, einem alten Kölner in Izmir angekommen!
Habe deine Datei heruntergeladen, und deine Version spielt keine Rolle. Excel 2003 ist Okay!
Haben zwei große Hunde, Belgischer Jagdhund, Kangal (Hirtenhund) und vier Katzen bei uns.

Normalerweise gibt man im Forum nur Rat und Hilfe zum Selbstlösen, auch bei Makro Codes.
Um meine Codes schreiben zu können benötigst du aber 10 Jahre VBA Programmier Erfahrung.
Ich laße deine Codes mal laufen und schaue was sie machen, ist ja alles Neuland für mich.

Dann schauen wir mal was man da konkret verbessern und optimieren kann. Vor allem Select!
Deine Codes sind zum Teil Makrorecorder Codes. Meine sind völlig anders, bei gleicher Funktion!
Wir verzichten auf Select, haben eine völlig andere Schreibweise der Syntacs.

Ich melde mich nach meinem ersten Testversuchen. Das geht aber nicht in fünf Minuten!

mfg Piet

Hallo

die Frage nach Dubletten suchen und löschen ist berechtigt. Dazu habe ich ein Makro geschieben.
Ich habe das 1. + 3. Makro auskommentiert, damit du wenigstens etwas verstehst wie es funktioniert.
Amüsant ist, das meine Programmiertechnik noch aus der alten Excel 7/95/97 Zeit stammt.
Viele Kollegen sind mit den modernen Befehlen besser als ich, stört mich aber nicht.

In Spalte C+D bekommst du den Dubletten Namen und die dazugehörigen Sheets angezeigt.
01/01 heisst, die Dublette befindet sich NUR im Sheet 01! -- 01/01/04 heisst, in Sheet 01+Sheet 04.
Ich hoffe das es euch weiterhilft die doppelten Daten zu löschen. Es zu programmieren war mir zuviel Arbeit.
https://www.herber.de/bbs/user/173675.xls

Würde mich freuen wenn euch diese Arbeit weiterhilft. Ehrenamtlichen Vereinen helfe ich gerne.
Wo genau befindet sich euer Verein, welcher Ort/ Stadt genau?? Vielleicht komme ich euch mal besuchen.

mfg Piet

Wahnsinn! Piet, du bist die Wucht in Tüten. Alle Probleme gelöst und noch viel besser, als ich es mir vorstellen konnte. Leider kann ich deinen Beitrag noch nicht als "Hervorragend" melden, weil ich keine 100 Beiträge geschrieben habe.

Wenn du noch mit sooo alten Versionen gearbeitet hast, bist du nicht mehr der Jüngste, da kannst du mega stolz drauf sein, dass du das alles noch kannst! Gruß und Dank an deine geistesgegenwärtige Tochter für ihren heldenhaften Einsatz! "Diplom-Krauler" an alle 4-Pfotler und dir das Bewusstsein, eine gute Tat vollbracht zu haben.

Unseren Verein findest du unter tierschutz-siebengebirge.de und auf Facebook und Insta. Leider können wir nur angemeldeten Besuch empfangen. Aber vielleicht klappt es ja tatsächlich mal irgendwann. Kaffee kannst du auf jeden Fall bei uns bekommen - halt keinen lebensrettenden türkischen. 😄 Anja und ich sind dir sehr sehr dankbar. 🙏

Beeindruckte, ehrfürchtige Grüße
Feli

Hallo Piet,

darf ich dich nochmal um Hilfe bitten?

Ich habe zunächst deine Makros in meiner Datei nicht zum Laufen gebracht, habe dann aber doch meinen Fehler gefunden. Also, die Auflistung der Vermittelten und Verstorbenen funzt perfekt. Mit den Daten von November sehe ich auch das tatsächliche Ergebnis.

Bei der Auflistung der Dubletten hängt sich das VBA immer an dieser Zeile auf:
If AC.DisplayFormat.Interior.Color <> 16777215 Then
mit dem Hinweis: Anwendungs- oder objektdefinierter Fehler

Das passiert mir auch, in deiner zweiten Datei, wenn ich die nochmal herunterlade.
Mache ich etwas falsch?

Ganz liebe Grüße aus dem Siebengebirge
Feli

Omg! Das ist ja großartig! Und das hat definitiv keine Eile. Die Namenslisten schaffe ich bis Weihnachten auch manuell. Habe ja auch noch nicht die Daten von November und Dezember. Wir müssen halt zwischendurch schon mal nach den Dubletten gucken. Wenn die Finder den Namen vergeben, kann das vorkommen. Ich hab die Aufbereitung der Statistik erst vor ein paar Tagen übernommen, um den Vorstand etwas zu entlasten. Ist alles ehrenamtlich bei uns.

Und ja, ich zeichne meine Makros tatsächlich auf, und versuche mit Hilfe von Onkel DuckDuckGo sowies VBA draus zu machen, leider ziemlich holprig. Wie gesagt VBA-Kenntnisse = bescheiden, und das ist noch geprahlt. Meeeeeeeega Dankeschön für deine soooo freundliche Antwort und die Zeit, die du für mich / für uns / für die Katzen investierst!

Hallo

was für ein Glück, das Makro war gerade fertig, als ich in Tabelle 9 sah das -Piet verstorben- ist!!
Meine Tochter konnte mich zum Glück mit Kaffee und Kuchen wiederbeleben! (Kölner Humor)

Mir fiel auf, das es bei Vermittlung offenbar zu zwei verschiedenen Dubletten kommt.
Einmal steht in Tabelle 01 Maja doppelt drin! Maja steht aber auch noch in anderen Tabellen.
Kann es sein das Maja noch mal aufgenommen, und ein zweites mal vermittelt wurde???
https://www.herber.de/bbs/user/173672.xls

mfg Piet

Hallo Piet!

Schreck lass nach, wenn man da so seinen eigenen Namen liest. Wie gut, dass du eine liebende Tochter hast! Haha, ich mag deinen Humor. Du bist/warst gar nicht weit weg von unserem Tierschutzverein. Du glaubst gar nicht, wie schön es ist, den Tieren Vertrauen und Liebe zu schenken und zurückzubekommen, damit sie eine gute Chance auf eine tolle Für-immer-Vermittlung haben. Deine haben bestimmt ein ganz tolles Zuhause gefunden.

Puh! Dein Code ist - seeehr kurz, elegant, professionell … Und so schick! Nach und nach erscheint jeder Name. Dafür kann ich mich gar nicht genug bedanken. Auch wenn ich rein gar nichts verstehe. :D
Du bist ja auch noch viel schneller und weiter, als ich je hoffen konnte. Und jetzt bin ich auch noch so undankbar und frage dich, ob ich ein einem Zwischenschritt mir noch die Dubletten anzeigen oder gar woanders hinschreiben lassen kann? Genauso, wie du das gemacht hast, damit man sieht, in welchen Monaten wir kontrollieren müssen. Wir haben ja angeblich auch vier Lillys vermittelt, davon zwei im Mai (zu Fuß ermittelt). Da kann wirklich was nicht stimmen.

Jetzt würde ich dir gerne ein paar ☕☕☕☕ rüber beamen. :) Bin schwer beeindruckt. Ich weiß nun sicher, dass ich nichts weiß. DANKE DANKE DANKE

Und noch einen entspannten Restsonntag ❣️

Guten Morgen GerdL,
das ist eine Schleife zum Löschen? Sorry, ich hab zu wenig Ahnung von VBA. Gelöscht werden soll ja VOR dem Erstellen der Liste. Bei mir hapert es auch noch mit dem eigentlichen Kopieren und Transponieren an der richtigen Stelle.
Ich schaue mal, wie ich das einbauen kann. Vielen Dank schon mal!

Zitat; "je länger ich mit Excel arbeitet," wenn du tatsächlich damit "arbeitest", dann tue dir und allen ,die dir Hilfe angedeihen lassen wollen etwas Gutes und besorge dir eine neuere(aktuelle) Excelversion. Damit wird es für Dich und andere Beteiligte, die dir helfen, erheblich einfacher.

Das würde ich sehr gerne Ralf, ist aber finanziell nicht drin. Ich scheue mich, diese Billiglizenzen auszuprobieren. Darüber habe ich nix Gutes gelesen. Meine Version war mal gratis. Du hast Recht, ich "arbeite" damit für den privaten Gebrauch.
Dir einen schönen Sonntag.

Ich nutze nur diese Billiglizenzen. Wobei "billig" relativ ist. Der Vorteil ist, du kannst dir bei einem Problem einen anderen Key schicken lassen falls Microsoft mal einen Key sperrt. Und am Funktionsumfang gibt es kaum was auszusetzen.