Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1372to1376
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-Makro; mach aus zwei eins ..

VBA-Makro; mach aus zwei eins ..
09.08.2014 09:13:52
WolfgangA
Hallo Excelfreunde,
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
und hier das andere Makro:
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
Deine Musterdatei wäre hier:
https://www.herber.de/bbs/user/91959.xlsm
es grüßt
Wolfgang

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

Betreff
Datum
Anwender
Anzeige
AW: VBA-Makro; mach aus zwei eins ..
09.08.2014 09:56:00
Werner
Hallo Wolfgang,
probier mal nach der codezeile ....shiftxldown
rngFound.EntireRow.copy
rngFound.Offset(1,0).EntireRow.PasteSpecial  xlPasteFormats
Ungetestet.
Gruß Werner

AW: VBA-Makro; mach aus zwei eins ..
09.08.2014 15:50:46
WolfgangA
Hallo Werner,
leider hat dies nicht funkioniert!
Debuger meldet eben diesen Eintrag als Fehler.
Wahrscheinlich geht sowas, was ich gerne haben möchte überhaupt nicht bei Excel, nur mauell!
Gruss Wolfgang

AW: VBA-Makro; mach aus zwei eins ..
11.08.2014 19:27:30
Werner
Hallo Wolfgang,
rngFound.entireRow.copy
rngFound.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
Werner

Anzeige
AW: VBA-Makro; mach aus zwei eins ..
11.08.2014 14:22:07
Gerold
Hallo Wolfgang
Wie wärs hiermit?

Option Explicit
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
rngFound.EntireRow.Copy
rngFound.Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
rngFound.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Protect
End If
End If
End Sub
Mfg Gerold
Rückmeldung wäre nett.

Anzeige
[Danke] AW: VBA-Makro; mach aus zwei eins ..
11.08.2014 19:58:53
WolfgangA
Hallo Gerold,
ganau so hatte ich es mir vorgestellt und es funktioniert.
Gottseidank! Für mich als "NO-VBA" ein Wunderwerk ;-)
es grüßt
Wolfgang

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige