Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
944to948
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
944to948
944to948
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Tabelleblatt kopieren hinterinander mit name
01.02.2008 17:37:00
karel
Hallo Forum,
Habe ein Tabellenblatt “Lieferant“ wobei ich für mehrere Lieferanten Berechnungen ausfuhren die aus ein Land kommen.
Beispiel https://www.herber.de/bbs/user/49579.xls
Mit unterstehende Makro Kopieren ich diese Tabelleblatt in eine neue Mappe mit nur werte und Format und Druckoptimiert.
Ich weis nicht ob nächste uberhaupt möglich ist aber ich hatte gerne dass diese Mappe automatisch gespeichert wird unter Namen des Land Zelle D4 und Datum D6
Beim Änderung von Lieferant muss diese gleiche Tabelle auch Kopiert werden aber unbedingt in der gleiche Mappe wie oben (hintereinander), man muss solange im gleich Mappe können Kopieren solange Land und Name Einkäufer gleich sind. Habe dan am ende einer Mappe mit alle Lieferanten von ein Land und einkäufer.
Wie kann ich Buttons nicht mit Kopieren, mit shapes.delete habe ich probiert.
Und kann man beim Kopieren in Neue Mappe die Tabellename direkt mit Zellwert Lieferant no Zelle D2 vergeben.
Vielleicht hat ihr auch andere ansetzen

Sub Copy_Supplier()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Order-Supplier")
Dim i As Long
Application.ScreenUpdating = False
With ws1
If [C65536] = "" Then
Loletzte = [C65536].End(xlUp).Row
Else
Loletzte = 65536
End If
For LoI = Loletzte To 2 Step -1
If .Cells(LoI, 2)  "" Then Exit For
Next LoI
.PageSetup.PrintArea = "$B$1:$Q$" & LoI + 1 'Printarea
'kopiert erst das Blatt und dann die Werte in neuem Blatt mit Wert einfügen
'ws1.Select
ws1.Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
For i = 1 To 56
ActiveWorkbook.Colors(i) = ThisWorkbook.Colors(i)
Next
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
End Sub


Viele Grusse
Karel

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelleblatt kopieren hinterinander mit name
01.02.2008 20:53:00
fcs
Hallo Karel,
deine Wunschliste kann man komplett umsetzen.
Die Zeilen, die du ggf. anpassen muss, hab ich entsprechend gekennzeichnet.
In diesen Zeilen werden der Pfad für die zu speichernden Datei, der Dateiname oder der Blattname festgelegt bzw. berechnet.
Zusätzlich hab ich auch eine kleine Fehlerbehandlung eingebaut, damit das Makro kontrolliert beendet wird, wenn z.B. ein Blatt mit der gleichen Lieferantennummer ein zweites mal kopiert werden soll.
Gruß
Franz

Sub Copy_Supplier()
Dim ws1 As Worksheet, wsZiel As Worksheet, wbZiel As Workbook
Dim Pfad As String, Dateiname As String, Blattname As String
Dim Fehler As Integer
Set ws1 = Worksheets("Lieferant")
Dim i As Long, Loletzte As Long, LoI As Long
Application.ScreenUpdating = False
On Error GoTo Fehlerbehandlung
Pfad = ThisWorkbook.Path 'Verzeichnis für die neuen Dateien ### ggf. anpassen
With ws1
If [C65536] = "" Then
Loletzte = [C65536].End(xlUp).Row
Else
Loletzte = 65536
End If
For LoI = Loletzte To 2 Step -1
If .Cells(LoI, 2)  "" Then Exit For
Next LoI
.PageSetup.PrintArea = "$B$1:$Q$" & LoI + 1 'Printarea
End With
'Prüfen ob Datei für Land und Datum schon angelegt
Dateiname = Pfad & "\" & ws1.Range("D4").Value & _
Format(ws1.Range("D6").Value, "YYYYMMDD") & ".xls" ' ### ggf. anpassen
If Dir(Pathname:=Dateiname) = "" Then
'1. Blatt wird in eine neue Datei kopiert
ws1.Copy
Set wbZiel = ActiveWorkbook
Set wsZiel = wbZiel.Worksheets(1)
wbZiel.SaveAs FileName:=Dateiname, AddtoMru:=True
'Farbtabelle übertragen
For i = 1 To 56
wbZiel.Colors(i) = ThisWorkbook.Colors(i)
Next
Else
'Weitere Blätter werden in bereits erstellte Datei kopiert
Set wbZiel = Workbooks.Open(FileName:=Dateiname, AddtoMru:=True)
ws1.Copy After:=wbZiel.Sheets(wbZiel.Sheets.Count)
Set wsZiel = ActiveSheet
End If
Fehler = 2
'Blattname festlegen
Blattname = "Lieferant" & ws1.Range("D2").Text ' ### ggf. anpassen
BlattnameFestlegen:
wsZiel.Name = Blattname
Fehler = 3
'Formeln durch Werte ersetzen
wsZiel.UsedRange.Copy
wsZiel.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Textfelder mit zugeordneten Makros löschen
Fehler = 4
wsZiel.Shapes("Textfeld 2").Delete
wsZiel.Shapes("Textfeld 3").Delete
Range("A1").Select
DateiSpeichern:
'Datei Speichern und schließen
Fehler = 5
wbZiel.Save
wbZiel.Close
Application.ScreenUpdating = True
GoTo Ende
Fehlerbehandlung:
MsgBox "Fehler Nummer " & Err.Number & " ist aufgetreten!" & vbLf & _
Err.Description
Select Case Fehler
Case 1
Case 2
Blattname = InputBox("Der Blattname mit der Lieferantennummer existiert bereits!" _
& vbLf & "Bitte den Blattnamen anpassen." & vbLf _
& "Bei Abbrechen wird das kopierte Blatt wieder gelöscht", _
"Lieferantenblatt kopieren", "Lieferant" _
& ws1.Range("D2").Text) ' ### ggf. anpassen
If Blattname  "" Then
GoTo BlattnameFestlegen
Else
Application.DisplayAlerts = False
wsZiel.Delete
Application.DisplayAlerts = True
GoTo DateiSpeichern
End If
Case 3
Case 4
MsgBox "Die Textfelder zum Kopieren des Blattes konnten nicht gefunden/gelöscht werden!"
Case 5
Case Else
End Select
Ende:
Set wbZiel = Nothing: Set ws1 = Nothing: Set wsZiel = Nothing
End Sub


Anzeige
AW: Tabelleblatt kopieren hinterinander mit name
02.02.2008 20:24:48
Karel
Hallo Franz,
Hut ab für dich habe lang gestestet, wenn anwender beim unterstehend Fehlermeldung ohne änderung auf OK klickt kommt er in Laufzeitfehler 1004 kann man dass abfangen.
Userbild
Habe code mit ordner anlegen ergänzt

Sub Copy_Supplier()
Dim ws1 As Worksheet, wsZiel As Worksheet, wbZiel As Workbook
Dim Pfad As String, Dateiname As String, Blattname As String
Dim Fehler As Integer
Set ws1 = Worksheets("Lieferant")
Dim i As Long, Loletzte As Long, LoI As Long
Application.ScreenUpdating = False
On Error GoTo Fehlerbehandlung
Pfad = ThisWorkbook.Path 'Verzeichnis für die neuen Dateien ### ggf. anpassen
With ws1
If [C65536] = "" Then
Loletzte = [C65536].End(xlUp).Row
Else
Loletzte = 65536
End If
For LoI = Loletzte To 2 Step -1
If .Cells(LoI, 2)  "" Then Exit For
Next LoI
.PageSetup.PrintArea = "$B$1:$Q$" & LoI + 1 'Printarea
End With
'Prüfen ob Ordner schon angelegt ist wenn nich dann Anlegen
If Dir("C:\test\Daten", vbDirectory) = "" Then MkDir "C:\test\Daten"
If Dir("C:\test\Supplier", vbDirectory) = "" Then MkDir "C:\test\Supplier"
'Prüfen ob Datei für Land und Datum schon angelegt
Dateiname = "C:\test\Supplier" & "\" & ws1.Range("D4").Value & _
Format(ws1.Range("D6").Value, "YYYYMMDD") & ".xls" ' ### ggf. anpassen '"C:\test" Pfad
If Dir(Pathname:=Dateiname) = "" Then
'1. Blatt wird in eine neue Datei kopiert
ws1.Copy
Set wbZiel = ActiveWorkbook
Set wsZiel = wbZiel.Worksheets(1)
wbZiel.SaveAs Filename:=Dateiname, AddtoMru:=True
'Farbtabelle übertragen
For i = 1 To 56
wbZiel.Colors(i) = ThisWorkbook.Colors(i)
Next
Else
'Weitere Blätter werden in bereits erstellte Datei kopiert
Set wbZiel = Workbooks.Open(Filename:=Dateiname, AddtoMru:=True)
ws1.Copy After:=wbZiel.Sheets(wbZiel.Sheets.Count)
Set wsZiel = ActiveSheet
End If
Fehler = 2
'Blattname festlegen
Blattname = "Lieferant" & ws1.Range("D2").Text ' ### ggf. anpassen
BlattnameFestlegen:
wsZiel.Name = Blattname
Fehler = 3
'Formeln durch Werte ersetzen
wsZiel.UsedRange.Copy
wsZiel.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Textfelder mit zugeordneten Makros löschen
Fehler = 4
wsZiel.Shapes("Textfeld 1").Delete
wsZiel.Shapes("Textfeld 2").Delete
wsZiel.Shapes("Textfeld 3").Delete
Range("A1").Select
DateiSpeichern:
'Datei Speichern und schließen
Fehler = 5
wbZiel.Save
wbZiel.Close
Application.ScreenUpdating = True
GoTo Ende
Fehlerbehandlung:
MsgBox "Fehler Nummer " & Err.Number & " ist aufgetreten!" & vbLf & _
Err.Description
Select Case Fehler
Case 1
Case 2
Blattname = InputBox("Der Blattname mit der Lieferantennummer existiert bereits!" _
& vbLf & "Bitte den Blattnamen anpassen." & vbLf _
& "Bei Abbrechen wird das kopierte Blatt wieder gelöscht", _
"Lieferantenblatt kopieren", "Lieferant" _
& ws1.Range("D2").Text) ' ### ggf. anpassen
If Blattname  "" Then
GoTo BlattnameFestlegen
Else
Application.DisplayAlerts = False
wsZiel.Delete
Application.DisplayAlerts = True
GoTo DateiSpeichern
End If
Case 3
Case 4
MsgBox "Die Textfelder zum Kopieren des Blattes konnten nicht gefunden/gelöscht werden!"
Case 5
Case Else
End Select
Ende:
Set wbZiel = Nothing: Set ws1 = Nothing: Set wsZiel = Nothing
End Sub


Habe noch eine Wunsch :-)
habe gerne dass gleiche wie oben aber statt neue ordner (Dateiname) anzulegen nur einmalig Tabelle Lieferanten kopieren in Datei C:\Etikett\[etikett.xls] hinter anstellen. Hintergrund ist dass einzelne Lieferant Eiketten kann generieren mit barcode EAN 13 (Funktioniert) fur Kartons. Tabelle die eingefügt wird muss noch mit Name Definieren werden, code die ich bis jetzt gefunden habe
With Worksheets("Lieferant")
.Range("B10:Q165").Activate
ActiveWorkbook.Names.Add Name:="ETI", RefersToR1C1:= _
"=Lieferant!R8C2:R71C17"
Viele Grusse
Karel

Anzeige
AW: Tabelleblatt kopieren hinterinander mit name
03.02.2008 23:39:00
fcs
Hallo Karel,
passe die Fehlerbehandlung etwas an. Statt "Goto" muss "Resume" zum Rücksprung in das Programm verwendet werden.
Die Input-Box zur Anpassung des Blattnamens wird dann wiederholt angezeig, bis der Name geändert wird oder Abbrechen gewählt wird. Resume bewikt, dass die Fehlerüberwachung zurückgesetzt wird.

Fehlerbehandlung:
MsgBox "Fehler Nummer " & Err.Number & " ist aufgetreten!" & vbLf & _
Err.Description
Select Case Fehler
Case 1
Case 2
Blattname = InputBox("Der Blattname mit der Lieferantennummer existiert bereits!" _
& vbLf & "Bitte den Blattnamen anpassen." & vbLf _
& "Bei Abbrechen wird das kopierte Blatt wieder gelöscht", _
"Lieferantenblatt kopieren", "Lieferant" _
& ws1.Range("D2").Text) ' ### ggf. anpassen
If Blattname  "" Then
Resume BlattnameFestlegen
Else
Application.DisplayAlerts = False
wsZiel.Delete
Application.DisplayAlerts = True
Resume DateiSpeichern
End If
Case 3
Case 4
MsgBox "Die Textfelder zum Kopieren des Blattes konnten nicht gefunden/gelöscht werden!"
Case 5
Case Else
End Select
Ende:
Set wbZiel = Nothing: Set ws1 = Nothing: Set wsZiel = Nothing
End Sub


Die Syntax für die Zuweisung eines Namens zu einem Zellbereich sieht ein wenig anders aus; Eigenschaft .ReferTo muss gesetzt werden. Hier dann der komplette Code, um das Blatt in der Datei C:\Etikett\Etikett.xls anzufügen.
Gruß
Franz


Sub Copy_to_Etikett()
Dim ws1 As Worksheet, wsZiel As Worksheet, wbZiel As Workbook
Dim Pfad As String, Dateiname As String, Blattname As String
Dim Fehler As Integer
Set ws1 = Worksheets("Lieferant")
Dim i As Long, Loletzte As Long, LoI As Long
Application.ScreenUpdating = False
On Error GoTo Fehlerbehandlung
Pfad = "C:\Etikett" 'Verzeichnis für die Etikett-Datei ### ggf. anpassen
With ws1
If [C65536] = "" Then
Loletzte = [C65536].End(xlUp).Row
Else
Loletzte = 65536
End If
For LoI = Loletzte To 2 Step -1
If .Cells(LoI, 2)  "" Then Exit For
Next LoI
.PageSetup.PrintArea = "$B$1:$Q$" & LoI + 1 'Printarea
End With
'Prüfen ob Datei Etikett.xls vorhanden
Fehler = 1
Dateiname = Pfad & "\Etikett.xls" ' ### ggf. anpassen
If Dir(Pathname:=Dateiname) = "" Then
MsgBox "Datei """ & Dateiname & """ ist nicht vorhanden!"
GoTo Ende
Else
'Blatt in Datei kopieren
Set wbZiel = Workbooks.Open(FileName:=Dateiname, AddtoMru:=True)
ws1.Copy After:=wbZiel.Sheets(wbZiel.Sheets.Count)
Set wsZiel = ActiveSheet
End If
Fehler = 2
'Blattname festlegen
Blattname = "Lieferant" & ws1.Range("D2").Text ' ### ggf. anpassen
BlattnameFestlegen:
wsZiel.Name = Blattname
Fehler = 3
'Formeln durch Werte ersetzen
wsZiel.UsedRange.Copy
wsZiel.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Textfelder mit zugeordneten Makros löschen
Fehler = 4
wsZiel.Shapes("Textfeld 2").Delete
wsZiel.Shapes("Textfeld 3").Delete
Range("A1").Select
DateiSpeichern:
Fehler = 5
' Bereich für Name "ETI" zuweisen
'direkt einem bestimmten Bereich
wbZiel.Names.Add Name:="ETI", RefersTo:="='" & wsZiel.Name & "'!$B$10:$Q$165"
'oder dynamisch entsprechend vorhandenen Daten _
(Spalten B bis Q ab Zeile 10 bis Ende Daten)
With wsZiel
wbZiel.Names.Add Name:="ETI", RefersTo:="='" & .Name & "'!" & _
.Range(.Cells(10, 2), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 15)).Address
End With
'Datei Speichern und schließen
wbZiel.Save
wbZiel.Close
Application.ScreenUpdating = True
GoTo Ende
Fehlerbehandlung:
MsgBox "Fehler Nummer " & Err.Number & " ist aufgetreten!" & vbLf & _
Err.Description
Select Case Fehler
Case 1
Case 2
Blattname = InputBox("Der Blattname mit der Lieferantennummer existiert bereits!" _
& vbLf & "Bitte den Blattnamen anpassen." & vbLf _
& "Bei Abbrechen wird das kopierte Blatt wieder gelöscht", _
"Lieferantenblatt kopieren", "Lieferant" _
& ws1.Range("D2").Text) ' ### ggf. anpassen
If Blattname  "" Then
Resume BlattnameFestlegen
Else
Application.DisplayAlerts = False
wsZiel.Delete
Application.DisplayAlerts = True
Resume DateiSpeichern
End If
Case 3
Case 4
MsgBox "Die Textfelder zum Kopieren des Blattes konnten nicht gefunden/gelöscht werden!"
Case 5
MsgBox "Problem bei der Zuweisung des Bereichs für Name ""ETI"""
Case Else
End Select
Ende:
Set wbZiel = Nothing: Set ws1 = Nothing: Set wsZiel = Nothing
End Sub


Anzeige
AW: Tabelleblatt kopieren hinterinander mit name
05.02.2008 21:11:00
Karel
Hallo Franz,
Du has ein Flasche Wein verdient, kann ich dich per Email erreichen (adresse)
Habe selbst noch etwas probiert sehe Code unter, jede Blatt bekommt eine eigene Name Definition brauche ich für Etikett Blatt, kann jetzt über sverweis indirekt jede Blatt einzel ansprechen.
Ein Problem habe ich noch Blätter werden in Arbeitblatt etikett kopiert, aber etikett dient eigentlich nur als Vorlage, kann man über eine Inputbox Arbeitsblatt unter eine andere Name Speichern. Arbeitsblatt etikett sollte nicht verändert werden
Habe auch noch Frage über mein Arbeitsblatt Etikett ( werden Aufkleber für Karton gemacht) kan / oder darf ich das mit dir weiter machen oder muss ich eine neue Thread offnen.

Sub Copy_to_Etikett()
Dim ws1 As Worksheet, wsZiel As Worksheet, wbZiel As Workbook
Dim Pfad As String, Dateiname As String, Blattname As String
Dim Fehler As Integer
Set ws1 = Worksheets("Lieferant")
Dim i As Long, Loletzte As Long, LoI As Long
Application.ScreenUpdating = False
On Error GoTo Fehlerbehandlung
Pfad = "C:\Etikett" 'Verzeichnis für die Etikett-Datei ### ggf. anpassen
With ws1
If [C65536] = "" Then
Loletzte = [C65536].End(xlUp).Row
Else
Loletzte = 65536
End If
For LoI = Loletzte To 2 Step -1
If .Cells(LoI, 2)  "" Then Exit For
Next LoI
.PageSetup.PrintArea = "$B$1:$Q$" & LoI + 1 'Printarea
End With
'Prüfen ob Datei Etikett.xls vorhanden
Fehler = 1
Dateiname = Pfad & "\Etikett.xls" ' ### ggf. anpassen
If Dir(Pathname:=Dateiname) = "" Then
MsgBox "Datei """ & Dateiname & """ ist nicht vorhanden!"
GoTo Ende
Else
'Blatt in Datei kopieren
Set wbZiel = Workbooks.Open(Filename:=Dateiname, AddtoMru:=True)
ws1.Copy After:=wbZiel.Sheets(wbZiel.Sheets.Count)
Set wsZiel = ActiveSheet
'Farbtabelle übertragen
For i = 1 To 56
wbZiel.Colors(i) = ThisWorkbook.Colors(i)
Next
End If
Fehler = 2
'Blattname festlegen
Blattname = "S" & ws1.Range("D2").Text ' ### ggf. anpassen
BlattnameFestlegen:
wsZiel.Name = Blattname
Fehler = 3
'Formeln durch Werte ersetzen
wsZiel.UsedRange.Copy
wsZiel.UsedRange.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Textfelder mit zugeordneten Makros löschen
Fehler = 4
wsZiel.DrawingObjects.Delete ' alle objecten löschen
'wsZiel.Shapes("Textfeld 11").Delete
'wsZiel.Shapes("Textfeld 12").Delete
Range("A1").Select
DateiSpeichern:
Fehler = 5
' Bereich für Name "ETI" zuweisen
'direkt einem bestimmten Bereich
wbZiel.Names.Add Name:=ActiveSheet.Name, RefersTo:="='" & wsZiel.Name & "'!$C$10:$Q$165"
'oder dynamisch entsprechend vorhandenen Daten _
(Spalten B bis Q ab Zeile 10 bis Ende Daten)
With wsZiel
wbZiel.Names.Add Name:=ActiveSheet.Name, RefersTo:="='" & .Name & "'!" & _
.Range(.Cells(10, 2), .Cells(.Rows.Count, 2).End(xlUp).Offset(0, 15)).Address
End With
'Datei Speichern und schließen
wbZiel.Save
wbZiel.Close
Application.ScreenUpdating = True
GoTo Ende
Fehlerbehandlung:
MsgBox "Fehler Nummer " & Err.Number & " ist aufgetreten!" & vbLf & _
Err.Description
Select Case Fehler
Case 1
Case 2
Blattname = InputBox("Der Blattname mit der Lieferantennummer existiert bereits!" _
& vbLf & "Bitte den Blattnamen anpassen." & vbLf _
& "Bei Abbrechen wird das kopierte Blatt wieder gelöscht", _
"Lieferantenblatt kopieren", "Lieferant" _
& ws1.Range("D2").Text) ' ### ggf. anpassen
If Blattname  "" Then
Resume BlattnameFestlegen
Else
Application.DisplayAlerts = False
wsZiel.Delete
Application.DisplayAlerts = True
Resume DateiSpeichern
End If
Case 3
Case 4
MsgBox "Die Textfelder zum Kopieren des Blattes konnten nicht gefunden/gelöscht werden!"
Case 5
MsgBox "Problem bei der Zuweisung des Bereichs für Name ""ETI"""
Case Else
End Select
Ende:
Set wbZiel = Nothing: Set ws1 = Nothing: Set wsZiel = Nothing
End Sub


Viele dank für alles was du gemacht hast
Karel
Ps Rot oder Weiss wein

Anzeige
AW: Tabelleblatt kopieren hinterinander mit name
06.02.2008 00:14:33
fcs
Hallo karel,
um die Etikett-Datei mit dem eingfügten Blatt unter einem anderen Namen zu speichern hast du 2 Möglichkeiten:
1. Im Code wird der Dateiname automatisch generiert und die Datei gespeichert
2. Der Dialog "Speichern unter" wird angezeigt.
Nachfolgend der anzupassende Codeabschnitt für beide Varianten.
Die Frage zur Etikett-Datei postest du besser in einem neuen Thread, da dieser in Kürze archiviert wird und dann nicht mehr so leicht zu finden ist.
Gruß
Franz

'Datei Speichern und schließen - direkt, Name wird automatisch generiert
wbZiel.Activate
Application.ScreenUpdating = True
wbZiel.SaveAs FileName:=wbZiel.Path & "\Ettikett_" & Blattname & _
Format(wsZiel.Range("D6"), "_YYYYMMDD") & ".xls", addtomru:=True
wbZiel.Close
GoTo Ende
'Datei Speichern und schließen - Dialog wird angezeigt
wbZiel.Activate
Application.ScreenUpdating = True
If Application.Dialogs(xlDialogSaveAs).Show = True Then
wbZiel.Close
End If
GoTo Ende


Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige