Zeile kopieren + einfügen

Sub kopieren_einfügen() Dim i As Integer Dim j As Integer Dim Sp as Integer i = 1 'Zeile, von wo aus gestartet wird = Counter, wie viele Zeilen j = 1 'Zeile, von wo aus gestartet wird = Counter, wie viele Zeilen Sp = 1 'Spalte, von wo aus gestartet wird = Counter, wie viele Spalten Do Until ActiveSheet.Range("A" & i).Value = "" 'Spalte A Zeilen zählen i = i + 1 Loop Do Until ActiveSheet.Range("K" & j).Value = "" 'Spalte K j = j + 1 Loop Do Until ActiveSheet.Range(Sp & "1").Value = "" 'In Zeile eins bei den Überschriften schauen Sp = Sp + 1 Loop If i > j Then 'so lange DB länger ist als Berechnung daneben Do Until i = j 'bis die Zeilen gleich sind ActiveSheet.Range(Cells(j, 11), Cells(j, Sp)).Select 'ab Spalte K (= 11) Zeilen markieren bis letzte Spalte = Counter Sp Selection.Copy Range(Cells(j + 1, 11), Cells(j + 1, Sp)).Select ActiveSheet.PasteSpecial xlPasteFormulas Loop End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Unit() Dim ez As Long, fz As Long With Range("K:K").SpecialCells(xlCellTypeFormulas) fz = .Row + .Rows.Count - 1 End With ez = Range("A:K").SpecialCells(xlCellTypeLastCell).Row If ez > fz Then With Range(Cells(fz, 11), Cells(fz, Columns.Count).End(xlToLeft)) .Copy .Offset(1).Resize(ez - fz).PasteSpecial xlPasteFormulas End With Application.CutCopyMode = False End If End Sub

Sub Formeln_expandieren() Dim LetzteZeile As Long Dim BereichZuBefüllen As Range Const Sp_anf = 1 'Spalte A Const Sp_end = 10 'spalte J ' ActiveSheet ist immer default, wenn nichts anderes eingegeben LetzteZeile = AnzahlZeilen_zählen(Sp_anf, Sp_end) If LetzteZeile > 2 Then Range("K3:DM9999").ClearContents Set BereichZuBefüllen = Range(.Range("k2"), Cells(LetzteZeile)) Range("K2:DM2").AutoFill Destination:=BereichZuBefüllen, Type:=xlFillDefault End If End Sub Private Function AnzahlZeilen_zählen(ersteSpalte, letzteSpalte) As Long Dim erg As Long Dim i As Long With ActiveSheet For i = ersteSpalte To letzteSpalte erg = WorksheetFunction.Max(erg, .Cells(99999, i).End(xlUp).Row) Next End With AnzahlZeilen_zählen = erg End Function

Sub Formeln_expandieren() Dim LetzteZeile As Long LetzteZeile = Range("A:K").SpecialCells(xlCellTypeLastCell).Row If LetzteZeile > 2 Then Range("K3:DM9999").ClearContents Range("K2:DM2").AutoFill Destination:=Range("K2:DM" & LetzteZeile), Type:=xlFillDefault End If End Sub

Hallo ihr beiden,
danke an euch für die Hilfsbereitschaft.
Ich hatte heute viel zu tun, deshalb komme ich jetzt erst zum Antworten.
@Gerd: Leider hat der Code nicht funktioniert. Ich habe die Ausgangsdatei um wenige Spalten eingekürzt, zusätzlich zu den nur 10 Zeilen, sie ist trotzdem noch zu groß zum Upload.
@Yal: Was ich an dem Code für mich nicht praktikabel finde, sind die festen Bezüge, d.h. "DM" oder "9999". Sobald die Tabelle länger oder breiter wird, wovon auszugehen ist, funktioniert es nicht mehr, wenn ich den Code richtig verstanden habe. Deshalb möchte ich gerne variable Bezüge.
Ich bin meinen Code noch einmal durchgegangen und konnte bereits die Fehler identifizieren. Er lautet nun:


Sub kopieren_einfügen()
Dim i As Integer
Dim j As Integer
Dim Sp As Integer
i = 6587 'Zeile, von wo aus gestartet wird = Counter, wie viele Zeilen
j = 6587 'Zeile, von wo aus gestartet wird = Counter, wie viele Zeilen
Sp = 114 'Spalte, von wo aus gestartet wird = Counter, wie viele Spalten
Do Until ActiveSheet.Range("A" & i).Value = "" 'Spalte A Zeilen zählen
i = i + 1
Debug.Print i
Loop
Do Until ActiveSheet.Range("K" & j).Value = "" 'Spalte K
j = j + 1
Debug.Print j
Loop
Do Until ActiveSheet.Cells(1, Sp).Value = "" 'In Zeile eins bei den Überschriften schauen
Sp = Sp + 1
Debug.Print Sp
Loop
If i > j Then 'so lange DB länger ist als Berechnung daneben
Do Until i - 1 = j - 1 'bis die Zeilen gleich sind
ActiveSheet.Range(Cells(j - 1, 11), Cells(j - 1, Sp - 1)).Select 'ab Spalte K (= 11) Zeilen markieren bis letzte Spalte = Counter Sp
Selection.Copy
j = j + 1
Range(Cells(j-1, 11), Cells(j-1, Sp-1)).Select
Selection.PasteSpecial xlPasteFormulas
Loop
End If
End Sub

Was sich zu vorher geändert hat ist das fett markierte. Oben stand vorher .range statt .cells.
Nicht wundern, ich habe die Counter höher gesetzt, weil ich sonst ewig warten muss, bis er unten angekommen ist (6.592 Zeilen).
Zudem habe ich das Minus eins eingefügt, weil er sonst die leere Zelle kopiert. Er muss ja eine davor gehen.
Zudem habe ich unten activesheet.paste...ersetzt mit selection.paste....
Das J=j+1 habe ich weiter oben angesetzt vor das zweite select.
Tja was soll ich sagen...es funktioniert....macht genau das was es soll.
Unglaublich.
Ich bin noch etwas sprachlos.
Keine Ahnung wie ich das hinbekommen habe. :D
Übrigens: Ich habe begonnen, hier zu schreiben, weil es noch nicht funktioniert hat und währenddessen fiel mir ein debug.print zu benutzen und dann hat sich der Rest irgendwie ergeben...ich hoffe ihr lest das, denn:
Ich danke euch beiden trotzdem von ganzem Herzen!
Liebe Grüße,
Sabi

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread