Office: Vorlage übernehmen

Hi, folgendes Problem:

Ich hab eine Excel Tabelle mit Daten der Weltbank auf Seite 1, auf Seite 2 seht Ihr die Vorlage wie die darauffolgenden Seiten alle aussehen sollen.
Sprich im Moment steht der Code soweit, als das er alle Länder auf einer eigenen Seite öffnet und deren jeweiligen Daten übernimmt und die Seitenbezeichnung das Kürzel des Landes ist. Passt ist einwandfrei und noch mal Danke dafür ^^

Nun is aber die Frage ist es überhaupt möglich das in diesen Code noch was geschrieben werden kann und zwar so das er das beibehält mit generierung der einzelnen Seiten mti den jeweiligen Daten und der aktualiserung auf der ersten seite und das dann nach hinten übertragen wird auf die zugehörige einzelseite...aber das dies zusätzlich dann immer wie in der vorlage wie auf seite 2 aussieht?!

ich hab kein plan ob das möglich ist und wenn ja wie, also wäre nice wenn da jemand helfen könnte.
und wie immer wenn euch ne info fehlt einfach kurz drunter schreiben ich trags dann schnellstmöglich nach.

Danke

 

Hallo Damien,

eine, möglichst zeitnahe, Rückmeldung im Thread wo Dir geholfen wurde wäre nicht nur höflich, sondern auch hilfreich für alle anderen Forenbenutzer und Hilfesuchenden.

Es ist zwar nicht einfach Deiner Beschreibung einen Sinn abzuringen, aber ich denke ich habe den Code so umgeändert wie Du es möchtest.
Die Blattvorlage habe ich gegen Deine "Seite 2" ausgetauscht, und anstatt einfach die entsprechende Zeile zu kopieren, werden die Zellwerte jetzt dorthin verteilt wo Du es möchtest.

Auch wenn dies aus Deiner Beschreibung nicht zu entnehmen ist, gehe ich mal davon aus, dass in die Zeilen 13 - 35 nichts einkopiert werden soll, da in diesen Bereichen irgendwelche externen Bezüge stehen.

ich hoffe geholfen zu haben.

 

sry for that but no hate.

sei es das ich da mittlerweile voll raus bin, aber wenn ich die neue datei runterlad macht die gar nix mehr bei mir oO wie gesagt kann durchaus an mir liegen weil ich einfach zu lang raus bin aus dem rpogrammier dingens und was überseh.

ich hab jetzt mal manuell eingefügt für eine seite wies aussehen soll.

Blatt 1: Die gesamten Daten

ab Blatt 2: Sollen dann die Daten von Blatt 1 jeweils in einem einzelnen neuen Blatt erscheinen, mit dem Country Code als Blattname und das ganze im Stil des Layouts von Blatt 2 jeweils.
Die generierung der einzelnen Seiten mit den jeweiligen Daten passt ja soweit einwandfrei im Original, Frage ist nur lässt sich darin nun auch nen Code platzieren welcher das Layout von Blatt 2 für alle Blätter verwendet?!

 

Hallo Damien,

das kann ich mir höchstens so erklären, dass Du die Makros nicht freigegeben hast.
Ansonsten, keine Ahnung.

Aber Du kannst auch was anderes machen:

Nimm Deine Datei vom 29.09.2011, 14:19.
Die hast Du als Beispiel gepostet, und sie wird wohl auch funktioniert haben, denke ich.
Blende das Blatt "Blattvorlage" ein (sichtbar machen), markiere dort die Spalten A bis W, wähle "Zellen löschen".
Wechsle auf auf das Blatt "Vorlage", markiere das ganze Blatt (in die Ecke links oben zwischen "A" und "1" klicken), wähle "kopieren" und füge es genauso in das Blatt "Blattvorlage" ein.
Lösche das Blatt "Vorlage".

Wechsle nun in den VBA-Editor.
Modul 4 kannst Du eigentlich löschen, ist unnötig.
Im Modul "Tabelle1" lösche sämtlichen Code und füge den folgenden Code dort ein.
Nun sollte alles klappen.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim strBlattname As String
Dim wksBlatt As Worksheet
Dim bolMappenschutz As Boolean
    
    If Target.Count = 1 And Target.Row > 1 Then
        
        If ThisWorkbook.ProtectStructure = True Then
            bolMappenschutz = True
            ThisWorkbook.Unprotect
        Else
            bolMappenschutz = False
        End If
        
        With Me
            strBlattname = .Cells(Target.Row, 5).Value
        End With
        
        With ThisWorkbook
            If strBlattname <> "" Then
                On Error Resume Next
                Set wksBlatt = .Worksheets(strBlattname)
                If Err = 0 Then
                    On Error GoTo 0
                Else
                    On Error GoTo 0
                    Application.ScreenUpdating = False
                    .Worksheets("Blattvorlage").Visible = True
                    .Worksheets("Blattvorlage").Copy after:=.Worksheets(.Worksheets.Count)
                    ActiveSheet.Name = strBlattname
                    Set wksBlatt = .Worksheets(strBlattname)
                    .Worksheets("Blattvorlage").Visible = False
                    Call TabellenblätterSortieren
                    Me.Activate
                    Application.ScreenUpdating = True
                End If
                wksBlatt.Cells(1, 2).Value = Me.Cells(Target.Row, 3).Value
                wksBlatt.Cells(2, 3).Value = Me.Cells(Target.Row, 4).Value
                wksBlatt.Cells(3, 3).Value = Me.Cells(Target.Row, 6).Value
                wksBlatt.Cells(4, 3).Value = Me.Cells(Target.Row, 7).Value
                wksBlatt.Cells(5, 3).Value = Me.Cells(Target.Row, 8).Value
                wksBlatt.Cells(6, 3).Value = Me.Cells(Target.Row, 9).Value
                wksBlatt.Cells(7, 3).Value = Me.Cells(Target.Row, 10).Value
                wksBlatt.Cells(8, 3).Value = Me.Cells(Target.Row, 11).Value
                wksBlatt.Cells(9, 3).Value = Me.Cells(Target.Row, 12).Value
                wksBlatt.Cells(10, 3).Value = Me.Cells(Target.Row, 13).Value
                wksBlatt.Cells(11, 3).Value = Me.Cells(Target.Row, 14).Value
                
                wksBlatt.Cells(36, 3).Value = Me.Cells(Target.Row, 20).Value
                wksBlatt.Cells(37, 3).Value = Me.Cells(Target.Row, 21).Value
                wksBlatt.Cells(38, 3).Value = Me.Cells(Target.Row, 22).Value
                wksBlatt.Cells(39, 3).Value = Me.Cells(Target.Row, 23).Value
            Else
                MsgBox "Country Code fehlt!"
            End If
        End With
        
        If bolMappenschutz = True Then ThisWorkbook.Protect
        
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim wksBlatt As Worksheet
Dim strBlattname As String
    
    If Target.Column = 3 And Target.Count = 1 And Target.Row > 1 Then
        If Target.Value <> "" Then
            With Me
                strBlattname = .Cells(Target.Row, 5).Value
            End With
            With ThisWorkbook
                On Error Resume Next
                Set wksBlatt = .Worksheets(strBlattname)
                If Err = 0 Then
                    On Error GoTo 0
                    .Worksheets(strBlattname).Activate
                Else
                    MsgBox "Dieses Arbeitsblatt existiert nicht."
                End If
            End With
        End If
    End If
End Sub

Public Sub TabellenblätterSortieren()

Dim intCounter1 As Integer
Dim intCounter2 As Integer
Dim intTabCounter As Integer
    
    With ThisWorkbook
        
        intTabCounter = .Worksheets.Count
        
        For intCounter1 = 3 To intTabCounter
            For intCounter2 = intCounter1 + 1 To intTabCounter
                If UCase$(Worksheets(intCounter2).Name) < UCase$(Worksheets(intCounter1).Name) Then
                    Worksheets(intCounter2).Move before:=Worksheets(intCounter1)
                End If
            Next intCounter2
        Next intCounter1
    End With
End Sub

Edit: Code ein wenig verkürzt.

 

thx so far, but....

hab jetzt alles so eingegeben wie du gesagt hast (nice schritt für schritt anleitung ) aber prob is wenn ich nun makro ausführen will tut sich gar nichts bei mir oO


edit [4.10. 15:34]
hab jetzt mal das modul4 wieder eingebaut, wo du meintest ich soll es löschen weil unnötig. nun funktionierts wieder soweit das alle seiten erstellt werden mit den jeweiligen daten und dem vorlagenlayout...jedoch setzt er die daten nicht richtig in das layout ein sondern einfach als 1 zeile darüber (was ja klar is da der code von früher so ist). sprich mit modul 4 is es es jetzt fast fertig fehlt nur noch das die daten auch in den richtigen zeilen landen

Modul4:
Sub NeuesBlatt()

Dim loLetzte As Long
Dim rgZelle As Range
Dim rgBereich As Range
Dim strBlattname As String
Dim wksBlatt As Worksheet

With ThisWorkbook

.Worksheets("Blattvorlage").Visible = True

With .Worksheets(1)
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 5)), .Cells(.Rows.Count, 5).End(xlUp).Row, .Rows.Count)
Set rgBereich = .Range(.Cells(2, 5), .Cells(loLetzte, 5))
End With

For Each rgZelle In rgBereich

On Error Resume Next
Set wksBlatt = .Worksheets(rgZelle.Value)
If Err <> 0 Then
On Error GoTo 0
.Worksheets("Blattvorlage").Copy after:=.Worksheets(.Worksheets.Count)
ActiveSheet.Name = rgZelle.Value
strBlattname = ActiveSheet.Name
.Worksheets(1).Rows(rgZelle.Row).EntireRow.Copy Destination:=.Worksheets(strBlattname).Rows(2)
End If
On Error GoTo 0

Next rgZelle

.Worksheets("Blattvorlage").Visible = False

End With

End Sub

 

Hallo Damien,

ich glaube jetzt habe ich verstanden was Dein Problem ist.
Einerseits mein Fehler, weil ich einfach vergessen habe, dass Du ja erstmal die ganzen Blätter überhaupt erzeugt haben möchtest, andererseits ist Deine unklare Ausdrucksweise auch nicht gerade hilfreich.
Möglichst genaue Beschreibung was (welche Funktion) nicht klappt, erleichtert manches.
Ich dachte, Deine externen Bezüge oder generell alle Makros wären jetzt bei Dir "out of order".


Also, mit diesem Makro "Private Sub Worksheet_Change(ByVal Target As Range)" kannst Du nicht alle Blätter auf einen Rutsch erstellen.
Das soll es auch garnicht können.
Dieses Makro "überwacht" Deine Tabelle auf Veränderungen, übernimmt die Werte in das entsprechende Blatt, und fügt auch ein Blatt hinzu, falls es noch nicht existiert.


Das was Du jetzt vermutlich meinst mit "tut sich gar nichts", dürfte wohl der ursprüngliche Zweck vom Modul 4 gewesen sein, nämlich einmalig für jedes Land der Liste ein eigenes Blatt zu erzeugen.
Da dies ja nur einmal geschehen muss, hatte ich es fälschlich schon von meiner Gedankenliste gestrichen, und es deshalb auch für überflüssig angesehen.


Ich habe den Code jetzt entsprechend angepasst:
Lasse das Makro "Sub NeuesBlatt()" in Modul 1 einmal laufen.
Nun solltest Du für jedes Land Deiner Liste ein eigenes Blatt haben.
Der Rest passiert ab jetzt über das Worksheet_Change-Ereignis.


Ich hoffe geholfen zu haben.

 

sehr nice ^^ passt perfekt soweit :)
und mit der beschreibung, werd ich in der zukunft versuchen mich da weng genauer auszudrücken...learning by doin' ^^

danke

 

Frage: Wie bekomm ich es hin das er für zeilen O-W auch die dort eingetragenen Werte übernimmt? Im Moment sind diese noch leer, aber im späteren Verlauf sollen diese mit Daten gefüllt werden auf dem ersten Blatt "Gesamt".

Im Moment ist auf der Vorlage hierfür noch ein Bezug zur Datei drin, hab das mal versucht rauszumachen und zu ersetzen...sprich bissle dran rumgespielt aber die automatisierung funktioniert weiterhin für die zeilen C-M perfekt, nur O-W klemmts noch.

 

Hallo Damien,

es fehlte nur O bis S.
T bis W war schon enthalten. Hast Du vermutlich nur nicht gesehen, weil die Zellen keine Werte enthalten.

Genau deshalb habe ich diese Spalten auch nicht mit eingeschlossen.


Habe Dir den Code jetzt entsprechend geändert, sowohl im Modul 1 als auch im Modul von Blatt 1.
In der Vorlage habe ich die externen Bezüge entfernt.


Hier mal was zur Erklärung:

Code:

wksBlatt.Cells(1, 2).Value = Me.Cells(Target.Row, 3).Value

"wksBlatt" referenziert auf das gewünschte Zielblatt
"Cells(1, 2)" referenziert auf die Zelle B1.
Im Gegensatz zur "normalen" Schreibweise für Zellbezüge (B1), wo zuerst die Spalte und dann die Zeile genannt wird, ist die Schreibweise in Makros genau umgekehrt. Dort wird zuerst die Zeile und dann die Spalte genannt.
"Cells(1, 2)" bedeutet also Zeile 1 / Spalte 2.

Mit "Me" wird hier auf das Blatt verwiesen, in dessen Modul sich der Code befindet.
"(Target.Row, 3)" ermittelt die Zeile, in der ein Wert geändert wurde, und verweist darin auf die dritte Spalte, also C.

Wenn Du dies einmal verstanden hast, kannst Du Deinen Code auch mal selber anpassen, falls sich Bezüge ändern.


Ich hoffe geholfen zu haben.

 

hey vielen dank werd mir die erklärung mal noch daheim richtig reinziehn

mfg