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

Beiträge aus den Excel-Beispielen zum Thema "Zellen höhe per makro kopieren"