Excel Bereich untereinander kopieren mit Msg Box

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Excel Bereich untereinander kopieren mit Msg Box
von: Max
Geschrieben am: 18.11.2015 22:07:08

Hallo zusammen,
ich würde gerne folgendes Durchführen, bekomme es aber leider nicht hin:
Ich habe in eine Tab in dem Bereich A7:BB45 Inhalte (Werte+Formeln) stehen und würde diesen gerne ab Zeile 46 so oft untereinander kopieren, wie ich in einer Inputbox eingebe.
Bekomme es leider nicht hin. Hoffe ihr könnt mir weiterhelfen!
Vielen Dank!!

Bild

Betrifft: AW: Excel Bereich untereinander kopieren mit Msg Box
von: Mullit
Geschrieben am: 18.11.2015 22:52:44
Hallo,
im Prinzip so:

Option Explicit

Public Sub test()
Dim lngIndex As Long
Application.ScreenUpdating = False
For lngIndex = 1 To Application.InputBox(Prompt:="Bitte Anzahl eingeben.", Title:="Kopien", Type:=1)
   With ActiveSheet
       Call .Cells(7, 1).Resize(39, 54).Copy(Destination:= _
           .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1))
   End With
Next
Application.ScreenUpdating = True
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 12

Gruß, Mullit

Bild

Betrifft: AW: Excel Bereich untereinander kopieren mit Msg Box
von: Sepp
Geschrieben am: 18.11.2015 23:23:57
Hallo Max,
so?

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub BereichKopieren()
Dim rng As Range
Dim lngAnswer As Long, lngStart As Long, lngC As Long

With Sheets("Tabelle3") 'Tabellenname anpassen!
  
  Set rng = .Range("A7:BB45")
  
  lngStart = rng.Cells(rng.Rows.Count, 1).Row + 1
  
  lngAnswer = Application.InputBox("Wie oft?", "Bereich kopieren", 1, Type:=2)
  
  If lngAnswer <> False Then
    If rng.Rows.Count * lngAnswer + lngStart > .Rows.Count Then
      MsgBox "sorry, that's too much!", vbExclamation
    ElseIf lngAnswer > 0 Then
      For lngC = 1 To lngAnswer
        rng.Copy .Cells(lngStart, rng.Cells(1, 1).Column)
        lngStart = lngStart + rng.Rows.Count + 1
      Next
    End If
  End If
End With
End Sub

Gruß Sepp


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Excel Bereich untereinander kopieren mit Msg Box"