P: Excel 2003 VBA - Kopieren von Zellen unter Beibehaltung der Größen

27/11/2007 - 21:04 von Markus Krätzschmar | Report spam
Hallo,

ich möchte gerne eine Tabelle kopieren, in der ich einige Zellen größer
gestaltet habe, als es die Textgröße verlangt. Das Ganze stellt ein
normiertes Formular dar, welches ausgefüllt werden muss.
Aus einem Tabellenblatt mit der Vorlage wird dies so oft wie nötig
herauskopiert und gefüllt.

Wie kann ich die exakte Gestaltung des Formulars aus einem Tabellenblatt in
ein anderes Tabellenblatt (mehrmals untereinander) übertragen?

Bisher kopiere ich so, aber das funktioniert nicht richtig:

wsTempForm.Activate
wsTempForm.Range("A1:Z69").Select
Application.CutCopyMode = False
Selection.Copy
wsFormAll.Activate
wsFormAll.Cells(intAktZeileEinzel, 1).Select
ActiveSheet.Paste

'Zeilennummer weiterschreiben für das nàchstemal
intAktZeileEinzel = intAktZeileEinzel + 69

Vielen Dank und viele Grüße

Markus
 

Lesen sie die antworten

#1 Claus Busch
27/11/2007 - 21:42 | Warnen spam
Hallo Markus,

Am Tue, 27 Nov 2007 21:04:10 +0100 schrieb Markus Kràtzschmar:

ich möchte gerne eine Tabelle kopieren, in der ich einige Zellen größer
gestaltet habe, als es die Textgröße verlangt. Das Ganze stellt ein
normiertes Formular dar, welches ausgefüllt werden muss.
Aus einem Tabellenblatt mit der Vorlage wird dies so oft wie nötig
herauskopiert und gefüllt.

Wie kann ich die exakte Gestaltung des Formulars aus einem Tabellenblatt in
ein anderes Tabellenblatt (mehrmals untereinander) übertragen?



die Spaltenbreite kannst du mit PasteSpecial xlPasteColumnWidths kopieren.
Für die Zeilenhöhe musst du leider eine Schleife über die Zeilen laufen
lassen, um die Höhe von der Originaldatei zu übertragen. Schau dir mal
folgenden Code an und passe ihn auf deine Bedürfnisse hin an:
Sub Kopieren()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lngAktZeileEinzel As Long
Dim n As Long
Dim i As Integer

Set ws1 = Sheets("TempForm")
Set ws2 = Sheets("FormAll")
lngAktZeileEinzel = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
n = 1

Application.ScreenUpdating = False

With ws1
.Range("A1:Z69").Copy
ws2.Cells(lngAktZeileEinzel, 1).PasteSpecial xlPasteAll
ws2.Cells(lngAktZeileEinzel, 1).PasteSpecial PasteColumnWidths
For i = lngAktZeileEinzel To lngAktZeileEinzel + 69
ws2.Rows(i).RowHeight = .Rows(n).RowHeight
n = n + 1
Next
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub


Mit freundlichen Grüssen
Claus Busch
Win XP Prof SP2 / Vista Ultimate
Office 2003 SP2 / 2007 Ultimate

Ähnliche fragen