Zeilen in dynamische Blätter kopieren

[Thomas P1]

Moin,

ich habe mir eine Tabelle angelegt, die dynamische Tabellenblätter anlegt.
Auf der Seite LV gebe ich jedesmal unterschiedliche Positionen ein, die dann die Blätter beschriften.
Soweit so gut.
Nun brauche ich in jedem Blatt eine andere Vorlage. Mal m² mal Stück.....
Dafür habe ich im selben Arbeitsblatt Volagen erstellt, und will die über ein Makro einfügen.
Leider kopiert er immer nur in das "aufgezeichnete" Blatt.
Wie kann ich das in das aktuell geöffnete kopieren.

Hier der aktuelle Code:

Sub mquadrat()
'
' mquadrat Makro
'
' Tastenkombination: Strg+o
'
    Sheets("m2").Select
    Cells.Select
    Selection.Copy
    Sheets("2.1 Vorbereiten der Oberfläche").Select
    Cells.Select
    Range("A1").Activate
    ActiveSheet.Paste
End Sub

PS.: habe leider so gut wie keine Ahnung von VBA.

 

[Yaslaw]

Poste doch mal dein Excel-Sheet, dann kann man einfacher helfen.
Der Code ist ja einfach eine Aufzeichnung, die ist wie immer bei aufgezeichnetem Code überladen und statisch.

 

[Thomas P1]

Moin,
danke erstmal für die Antwort.
Ich hoffe das Bild hilf weiter

 

[Yaslaw]

Kannst du uns entweder die Datei zur Verfügung stellen oder mindestens die Seite Zeigen, in der die Vorlagen liegen (Tabelle LV)?

 

[Thomas P1]

Der lässt mich keine Exel hochladen.
LV ist nur die Basis für die Registerbenennung. Die Vorlagen sind h ; Stück , Psch, m2 ,m3

 

[Yaslaw]

Dann wirf die Datei in ein zip.
LV ist die spannende sache, denn dort willst du ja nachschauen welche Art Template du verwenden willst.
Ich kann die auch ein wenig Programmcode so schreiben, nur musst du dann garantiert alles umschreiben um auf dein LV anzupassen - oder ich kann aufgrund deiner LV-Tabelle helfen und wir reden vom gleichen wenn wir zB die Zelle B23 meinen.

 

[Thomas P1]

ok,da ist sie

 

[Yaslaw]

So auf die schnelle. Bevor ich die winzelnen Schritte weiter erkläre, bitte ich dich, die VB-Befehle de du nicht kennst mal mit F1 kennenzulernen.

Public Sub createSheets()
    Dim wsLV As Worksheet
    Dim rngSheetInfos As Range
    Dim rngSheetInfo As Range
    Dim sheetName As String
    Dim lvIndex As Long
    Dim wsTemplate As Worksheet
    Dim wsNew As Worksheet
    
    'Tabelle LV auslesen
    Set wsLV = ThisWorkbook.Sheets("LV")
    'Bereich mit den Informationen auslesen
    Set rngSheetInfos = wsLV.Range("A6:E" & xlsGetLastRow(wsLV))
    
    'Alle Zeilen in diesem Bereich durchgehen
    For Each rngSheetInfo In rngSheetInfos.Rows
        'Wenn in der ersten Spalte nix drin steht, die Schleife abbrechen
        If rngSheetInfo.Cells(1, 1) = "" Then Exit For
        
        'Name der neuen Tabelle generieren
        sheetName = rngSheetInfo.Cells(1, 1) & " " & rngSheetInfo.Cells(1, 2)
        
        'Art (ME) auswerten und ein Template auswählen.
        Select Case LCase(rngSheetInfo.Cells(1, 5))
            Case "m²", "m2":            Set wsTemplate = ThisWorkbook.Sheets("m2")
            Case "psch":                Set wsTemplate = ThisWorkbook.Sheets("psch")
            Case "st", "stück":         Set wsTemplate = ThisWorkbook.Sheets("stück")
            Case Else:
                'Es konnte kein Template zu dieser Art gefunden werden. Prozess abbrechen
                MsgBox "Dem ME '" & rngSheetInfo.Cells(1, 5) & "' ist kein Template zugewiesen"
                Exit For
        End Select
        
        'Template ans Ende kopieren
        wsTemplate.Copy after:=getLastSheet()
        'Neue Tabelle benamsen
        getLastSheet().Name = sheetName
    Next
    
End Sub

'/**
' * Gibt die letzte Tabelle zurück
' * @return Worksheet
' */
Private Function getLastSheet() As Worksheet
    Set getLastSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End Function

'/**
' * ermitteln der letzten gefüllten Zeile eines Worksheets
' * Die Funktion Sheet.Cells.SpecialCells(xlCellTypeLastCell) liefert auch instanzierte Zeilen ohne Inhalt
' * http://wiki.yaslaw.info/wikka/vbaExcelGetLastRowCol
' * @param  Worksheet               Eine Referenz auf das Worksheet
' * @return Long                    Zeilenindex der letzten Zeile mit Inhalt
' */
Public Function xlsGetLastRow(ByRef Sheet As Excel.Worksheet) As Long
    Dim r As Variant
 
    xlsGetLastRow = Sheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    For r = xlsGetLastRow To 1 Step -1
        If Sheet.Application.WorksheetFunction.CountA(Sheet.Rows(r)) = 0 Then
            xlsGetLastRow = r - 1
        Else
            Exit For
        End If
    Next r
End Function

 

[Thomas P1]

vielen Dank, funktioniert super. Die zusäztlichen Vorlagen kann ich selber einpflegen. "Keine Template" hat eine Blankovorlage bekommen, da die einheiten oft uneinheitlich sind.
Nur die Benennung habe ich nicht verstanden.
Ich kann mir zwar behelfen, aber ideal wäre die Zuweisung der Spalte "w". Da sind die gekürzten Zusammenfassungen aus Positionsnummer und Text. Ist auch gleichzeitig der gedruckte Aufmaßtitel.
Auf jeden Fall nocheinmal großen Dank

 

[Yaslaw]

In der Zeile Set rngSheetInfos = wsLV.Range("A6:E" & xlsGetLastRow(wsLV)) ist ja der Bereich abgedeckt, der die Infos behandelt. In dem Fall bis Spalte E. Da kannst du aber auch Breiter machen.
Nachher greifft man mittels rngSheetInfo.Cells(1, 5) Auf das Feld des jeweiligen Datensatzes zu. In dem Fall das 5te (also Spalte E).
So kannst du problemlos auch mit anderen Spalten arbeiten.