VBA-Makro; mach aus zwei eins ..
09.08.2014 09:13:52
WolfgangA
zu meiner Frage habe ich noch keine entgültige Lösung gefunden, könnte aber hier die entsprechende VBA-Hilfe bekommen?
Ich wollte ja über ein Makro Zeilen einfügen, die erst nach dem Sprungziel eingefügt werden sollen und die Formatierung der darüberliegenden Zeile mit übernehmen.
Ein Makro vom Gerd für das "Einfügen" habe ich ja bekommen. Nur die Formate wurden nicht übertagen.
Nach vielen Suchen habe ich ein passendes Makro gefunden, aber wie bekomme ich nun diese beiden Makros so zusammen, dass es auch funktioniert!
Leider habe ich von VBA wenig Ahnung.
Hier mal das Makro von Gerd:
Sub a()
Dim rngFound As Range
Set rngFound = Columns(1).Find(what:="EZ", after:=Cells(1, 1), lookat:=xlWhole, LookIn:= _
xlValues, searchdirection:=xlPrevious)
If Not rngFound Is Nothing Then
If Not IsEmpty(rngFound.Offset(1, 0)) Then
ActiveSheet.Unprotect
rngFound.Offset(1, 0).EntireRow.Insert shift:=xlDown
End If
ActiveSheet.Protect
End If
End Sub
Option Explicit
Sub InsertRowsSpecial()
Dim CopyRng As Range
Dim AutoFillRng As Range
Dim InsertRows As Range
Dim Spalte As Range
Dim RowsToInsert As Long
With ActiveSheet
'Anpassen-------------------------------------------------------
Set CopyRng = .Columns("D")
Set AutoFillRng = Union(.Columns("A"), .Columns("C"), .Columns("D"), .Columns("J"), . _
Columns("K"))
'Anpassen-------------------------------------------------------
ActiveSheet.Unprotect
Set InsertRows = Application.InputBox("Markieren Sie die ""Referenz-Zeile""!", "Zeilen _
einfügen", Type:=8)
Debug.Print InsertRows.Address
RowsToInsert = InputBox("Wie viele Zeilen sollen eingefügt werden?", "Zeilen einfügen")
Set InsertRows = InsertRows.Resize(RowsToInsert, .Columns.Count)
InsertRows.Insert Shift:=xlDown
Set InsertRows = InsertRows.Offset(-InsertRows.Rows.Count, 0)
For Each Spalte In AutoFillRng.Columns
With Intersect(Spalte, InsertRows.Resize(InsertRows.Rows.Count + 1))
.Cells(.Rows.Count, 1).AutoFill Destination:=Range(.Address(0, 0))
End With
Next
For Each Spalte In CopyRng.Columns
With Intersect(Spalte, InsertRows)
.Value = .Cells(.Rows.Count, 1).Offset(1, 0)
End With
Next
End With
ActiveSheet.Protect
End Sub
https://www.herber.de/bbs/user/91959.xlsm
es grüßt
Wolfgang
Anzeige