Herbers Excel-Forum - das Archiv

Zellen höhe per makro kopieren

Bild

Betrifft: Zellen höhe per makro kopieren
von: louis

Geschrieben am: 15.02.2005 21:18:24
hallo forum,
ich brauche eure hilfe
ich kopiere zb range("B2:D8") immer in die nächste freie zeile eines neuen arbeitsblattes.
nun möchte ich aber auch die zeilenhöhe und die zeilenbreite immer mitkopieren.
bekomme das ganze aber nicht wirklich hin.
kann mir jemand helfen? würde mich sehr weiterbringen
danke im vorraus
mfg
louis
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: Ulf

Geschrieben am: 15.02.2005 21:44:57
Mit kopieren geht das nur, wenn du die ganze Spalte/Zeile kopierst.
Für die Spalten muss das nur einmalig gemacht werden, für Zeilen jedesmal.
mal für Spalte A:
Sheets(2).[a1].ColumnWidth = Sheets(1).[a1].ColumnWidth
für eine zeile:
Sheets(2).[b1].RowHeight = Sheets(1).[b1].RowHeight
Ulf
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: louis

Geschrieben am: 15.02.2005 21:54:22
hallo ulf
danke für die antwort
aber genau das will ich eben nicht. es soll nicht die ganze zeile mitkopiert werden.
ich werde es mal weiter versuchen indem ich die zellen höhe und breite auslese und irgendwie in den copy-vorgang mit einbringe
danke nochmal
mfg
louis
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: Ulf
Geschrieben am: 15.02.2005 22:02:34
Meine Codebeispiele kopieren nicht, sie weisen nur Breite bzw. Höhe zu.
Ulf
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: louis

Geschrieben am: 15.02.2005 22:26:15
jab habe ich jetzt auch begriffen, sorry
mein problem liegt halt da das ich das selectierte range in die nächste freie spalte kopiere und noch nicht genau weiss wie ich das zuordnen soll.
also das ist mein code: (bitte nicht lachen da bin ich stolz drauf das ich den mit eurer hilfe hinbekommen habe)
Private Sub Übernehmen_Block_Anzahl_Click()     'einfügen der einzelnen Blöcke in die Tabelle
If Cells(14, 32).Value = 1 Then
A = 27
End If
If Cells(14, 32).Value = 2 Then
A = 39
End If
If Cells(14, 32).Value = 3 Then
A = 51
End If
If Cells(14, 32).Value = 4 Then
A = 63
End If
If Cells(14, 32).Value = 5 Then
A = 75
End If
If Cells(14, 32).Value = 6 Then
A = 87
End If
If Cells(14, 32).Value = 7 Then
A = 99
End If
Dim Sh As Shape, mat As Range
Set mat = Range(Cells(17, A), Cells(125, 101))
For Each Sh In ActiveSheet.Shapes
If Not Intersect(Sh.TopLeftCell, mat) Is Nothing Then Sh.Delete
Next
ActiveWindow.SmallScroll Down:=21
Range(Cells(17, A), Cells(125, 101)).Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Y = Cells(17, 17) + Cells(17, 27) + Cells(17, 39) + Cells(17, 51) + Cells(17, 63) + Cells(17, 75) + Cells(17, 87) + Cells(17, 99)
If Cells(14, 32).Value - Y > 0 Then
Dim Check, Counter
Test = True: Zähler = 0  ' Variablen initialisieren.
Do    ' Äußere Schleife.
Worksheets("Protokoll").Range("C17:N25").Select
Selection.Copy
Do While Zähler < 8
X = 14
SucheLeer:
If Cells(17, X).Value = "" Then
Range(Cells(17, X), Cells(17, X)).Select
ActiveSheet.Paste
Else
X = X + 1
GoTo SucheLeer
End If
Zähler = Zähler + 1    ' Zähler hochzählen.
If Zähler = Cells(14, 32).Value - Y Then ' Wenn Bedingung = True,
Test = False    ' Attributwert auf False setzen.
Exit Do    ' Innere Schleife verlassen.
End If
Loop
Loop Until Test = False
End If
Application.CutCopyMode = False
Range("O9:O9").Select
End Sub

ich müsste das ja in diesen teil in etwa so mit reinbringen
If Cells(17, X).Value = "" Then
Range(Cells(17, X), Cells(17, X)).Select
ActiveSheet.Paste
AB=X+1
AC=X+2
AD=X+3
Cells(17, X).ColumnWidth = 20
Cells(17,AB).ColumnWidth = 18
Cells(17,AC).ColumnWidth = 24
Cells(17,AD).ColumnWidth = 30
ich weiss das es nicht so geht mir geht es halt um den ansatz.
wenn ich nerve ruhig sagen.
mfg
louis
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: Ulf
Geschrieben am: 15.02.2005 22:47:57
Du nervst gar nicht. Ich hab nur echt keinen Bock, mich durch den Code zu wurschteln,
daher noch offen.
Ulf
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: louis

Geschrieben am: 15.02.2005 23:52:04
ich bin´s noch mal.
also ich habe jetzt mal ein bisschen probiert und bin zu folgendem gekommen.
If Cells(17, X).Value = "" Then
Range(Cells(17, X), Cells(17, X)).Select
ActiveSheet.Paste
aa = X + 1
ab = X + 2
ac = X + 3
u.s.w
With Worksheets("Protokoll").Columns(X)
.ColumnWidth = 0.58
End With
With Worksheets("Protokoll").Columns(aa)
.ColumnWidth = 0.58
End With
With Worksheets("Protokoll").Columns(ab)
.ColumnWidth = 5.86
End With
With Worksheets("Protokoll").Columns(ac)
.ColumnWidth = 5.86
End With
u.s.w
Else
X = X + 1
GoTo SucheLeer
End If
so wird es so wie ich es gerne hätte gibt nur einen ellen langen code wenn ich das ganze für spalten und zeilen mache.
kann man das optimieren oder ganz anders machen.
danke für die mühe und geduld, ist ein spitzen forum hier.
mfg
louis
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: Ulf
Geschrieben am: 16.02.2005 00:21:26
Find ich toll, wie du dich da reinhängst, weiter so.
Ulf
Bild

Betrifft: AW: Zellen höhe per makro kopieren
von: louis

Geschrieben am: 17.02.2005 17:16:19
kleine rückmeldung
das ist jetzt die kürzeste möglichkeit auf die ich gekommen bin

If Cells(17, X).Value = "" Then
Range(Cells(17, X), Cells(17, X)).Select
ActiveSheet.Paste
Columns(X).ColumnWidth = 0.58
Columns(X+1).ColumnWidth = 0.58
u.s.w
mfg
louis
 Bild
Excel-Beispiele zum Thema "Zellen höhe per makro kopieren"
Makros in Abhängigkeit vom Zellennamen aufrufen Zellen auf Kommentar überprüfen
Spalten bedingt summieren und Zellen formatieren Text aus Textbox in Zellen aufteilen
Zellen vergleichen und markieren Zählen formatierter Zellen
Daten aus Textdatei gezielt in Zellen übernehmen Zellen verbinden und trennen
Zellen bei Minuswerten schraffieren Zeilen oberhalb der markierten Zellen einfügen