Werte übertragen und Rahmen zeichnen 2.0
19.11.2018 13:26:04
Jochen
meine vorherige Frage ist glaube ich in der Versenkung verschwunden, deshalb das Ganze hier nochmal.
Mein Problem:
Ich schreibe momentan mittels VBA ein Makro. Unteranderem soll es Folgendes beinhalten:
Auf einem 1. Excel Sheet steht eine (undefinierte) Anzahl an Werten untereinander. Nun soll das Makro diese Werte genauso übernehmen wie es auf dem 1. Sheet steht und auf einen 2. Sheet übertragen. Zusätzlich soll es aber noch einen Rahmen um jede Zelle ziehen, so dass ich am Ende auf dem 2. Sheet eine Tabelle mit Rahmen habe, die genau so viele Spalten beinhaltet, wie die Anzahl der Werte auf dem 1. Sheet. Dabei kann die Anzahl an Werten auf Sheet 1 natürlich jedes mal schwanken, so dass ich nicht einfach eine Maske auf Sheet 2 anfertigen kann, die dann nur jedes mal ausgefüllt werden müsste. Das ganze sollte für mehrere Tabellen auf einem Sheet funktionieren.
Ich habe mal eine Beispieldatei erstellt an der es deutlich werden sollte. In "Tabelle1" stehen die Werte die in die "Tabelle3" reingeschrieben werden sollen. Am Ende soll es dann aussehen wie in "Tabelle2".
https://www.herber.de/bbs/user/125427.xlsx
Ich habe schon eine Lösung bekommen, nur leider funktioniert sie nur für eine Tabelle, und nicht für mehrere.
Sie sieht so aus:
Public Sub Daten_und_Rahmen()
Dim loLetzteQ As Long, loLetzteZ As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loLetzteQ = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(3, 2), .Cells(loLetzteQ, 2)).Copy
With Worksheets("Tabelle3")
loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Row
.Cells(loLetzteZ, 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Columns(2).HorizontalAlignment = xlCenter
.Columns(2).Font.Bold = True
loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
With .Range(.Cells(3, 2), .Cells(loLetzteZ, 11))
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders.Weight = xlMedium
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders.Weight = xlMedium
End With
End With
End With
End Sub
Viele Grüße,
Jochen