Excel 2013 vba: Bereich kopieren

[sharky51]

Hallo zusammen,

für Euch sicher ein banales Problem aber ich komme nicht auf die Lösung.

In einem Tabellenblatt möchte ich einen Bereich mit allen Formaten (Zeilenhöhe und Breite) kopieren und im gleichen Tabellenblatt an einer anderen Stelle einfügen.
Also Bereich auswählen, kopieren, andere Zelle per Maus auswählen, kopierte Auswahl einfügen.

Vielleicht habt jemand eine Idee das mittels Makro zu erledigen.

[schauan]

Hallöchen,
kopieren könntest Du leider nur die Spaltenbreite. Die Zeilenhöhe musst Du einzeln einstellen

Code:

Sub test()
Sheets("Tabelle1").Range("A1:C3").Copy
Sheets("Tabelle2").Range("A1").PasteSpecial
'Spaltenbreite kopieren
Sheets("Tabelle2").Range("A1").PasteSpecial Paste:=8
'Schleife ueber alle Zeilen
For icnt = 1 To 3
  'Zeilenhoehe uebernehmen
  Sheets("Tabelle2").Rows(icnt).RowHeight = Sheets("Tabelle1").Rows(icnt).RowHeight
'Ende Schleife ueber alle Zeilen
Next
End Sub

[sharky51]

Hallo Andre,

vielen Dank für Deinen Beitrag, hilft schon mal weiter.

Aber wie geht das ohne feste Zelladressen?
Ich möchte einen zu kopierenden Bereich markieren und dann auf dem gleichen Blatt an einer anderen Stelle wieder einfügen.
Das Makro muss ev. angehalten werden um die Zielzelle auswählen zu können...um dann den Kopiervorgang abzuschließen + Spaltenbreite und Höhe.
Vielleicht gibt es für mein Vorhaben ja noch eine einfachere Lösung?

[GMG-CC]

Moin,
du kannst einen Bereich markieren und dann in ein Array schreiben. Dann per InputBox die Ziel-Zelle (obere linke Ecke) abfragen und dort dann einfügen. Erforderlichenfalls den Zielbereich noch darauf prüfen, ob er leer ist oder nicht.

[schauan]

Hallo Erich,

das könnte dann so aussehen:

Code:

Sub test()
'Variablendeklarationen
Dim rngTarget As Range, rngSource As Range
'Bei Fehler weiter mit nächstem Kommando
On Error Resume Next
'Kopierbereich auswaehlen
Set rngSource = Application.InputBox("Wählen Sie den Bereich zum Kopieren aus:", _
                     "Bereich kopieren", , , , , , 8)
If rngSource Is Nothing Then Exit Sub        ' Auswahl abgebrochen
'Zielzelle auswaehlen - obere linke zelle des Einfuegebereichs
'Hinweis: Keine Fehlerpruefung auf Auswhal mehrere Zellen
Set rngTarget = Application.InputBox("Wählen Sie die Zelle zum Einfügen aus:", _
                     "Bereich kopieren", , , , , , 8)
'Fehlerbehandlung Ende
On Error GoTo 0
If rngTarget Is Nothing Then Exit Sub        ' Auswahl abgebrochen
'Bereich kopieren
rngSource.Copy
'Daten einfuegen
rngTarget.PasteSpecial
'Spaltenbreite kopieren
rngTarget.PasteSpecial Paste:=8
'Schleife ueber alle Zeilen
For icnt = rngTarget.Row To rngTarget.Row + Selection.Rows.Count - 1
  'Zeilenhoehe uebernehmen
  Rows(icnt).RowHeight = rngSource.Rows(icnt).RowHeight
'Ende Schleife ueber alle Zeilen
Next
End Sub

[sharky51]

Hallo André,

super, super ....genau das habe ich gesucht!!!!
Funktioniert perfekt, vielen Dank!!!!

[Käpt'n Blaubär]

Hallo André,

ein kleiner Hinweis der Vollständigkeit halber, beim Erich läuft es zwar, aber mit Option Explicit meckert VBA.
Folglich wird dort kein Option Explicit eingesetzt.

VBA vermißt:

Dim icnt As Long

... dann läuft's auch mit dem Nachbarn  :15: