Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

VBA-Makro; mach aus zwei eins ..

Betrifft: VBA-Makro; mach aus zwei eins .. von: WolfgangA
Geschrieben am: 09.08.2014 09:13:52

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

  

Betrifft: AW: VBA-Makro; mach aus zwei eins .. von: Werner
Geschrieben am: 09.08.2014 09:56:00

Hallo Wolfgang,

probier mal nach der codezeile ....shiftxldown

rngFound.EntireRow.copy
rngFound.Offset(1,0).EntireRow.PasteSpecial  xlPasteFormats
Ungetestet.

Gruß Werner


  

Betrifft: AW: VBA-Makro; mach aus zwei eins .. von: WolfgangA
Geschrieben am: 09.08.2014 15:50:46

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


  

Betrifft: AW: VBA-Makro; mach aus zwei eins .. von: Werner
Geschrieben am: 11.08.2014 19:27:30

Hallo Wolfgang,

rngFound.entireRow.copy
rngFound.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
Werner


  

Betrifft: AW: VBA-Makro; mach aus zwei eins .. von: Gerold
Geschrieben am: 11.08.2014 14:22:07

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.


  

Betrifft: [Danke] AW: VBA-Makro; mach aus zwei eins .. von: WolfgangA
Geschrieben am: 11.08.2014 19:58:53

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