Zeilen einfügen zwischen zwei benannten Bereichen

Hallo Excelprofis - ein gesundes und erfolgreiches neues Jahr wünsche ich zunächst.
Mein Problem: Ich möchte von Arbeitsblatt1 Spalte B1:E1 bis zur letzten Zeile nach Arbeitsblatt2, Spalte B6:E6 kopieren. Das Vertrackte dabei ist, dass ich in Arbeitsblatt2, Spalte B7:E7 bereits Daten habe, die erhalten bleiben müssen. B7 ist als ("Ausdruck_Fußzeile") benannt.
Mit


Sheets("2").Range("B6").Insert Shift:=xlDown

funktioniert es leider nicht. Der benannte Bereich wird gelegentlich und für mich nicht nachvollziehbar überschrieben. Damit funktioniert das löschen mit:

With wksZ
If Range("Ausdruck_Fußzeile").Row  7 Then
Range("B7:B" & Range("Ausdruck_Fußzeile").Row - 1).EntireRow.Delete
Rows("6:6").ClearContents
End If
End With

nicht mehr. Wie bekomme ich die Daten von Arbeitsblatt1 Spalte B1:E1 (bis zur letzten Zeile) nach Arbeitsblatt2, Spalte B7:E7, ohne dass der benannte Bereich überschrieben wird?
Gruß Vic

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub eintragen() Dim wksQ As Worksheet, wksZ As Worksheet Dim zeilevon As Long, anzahl As Long Set wksQ = Worksheets("Tabelle1") '--Blattname anpassen Set wksZ = Worksheets("Tabelle2") '--Blattname anpassen anzahl = wksQ.Cells(1, 2).CurrentRegion.Rows.Count zeilevon = Range("Ausdruck_Kopfzeile").Row wksZ.Rows(zeilevon + 1 & ":" & zeilevon + anzahl).Insert Shift:=xlDown wksZ.Cells(zeilevon + 1, 2).Resize(anzahl, 4).Value = wksQ.Cells(1, 2).Resize(anzahl, 4) _ .Value End Sub

Sub ZeilenLoeschen() Dim wksZ As Worksheet Dim zeilevon As Long, zeilebis As Long Set wksZ = Worksheets("Tabelle2") '--Blattname anpassen If Range("Ausdruck_Fußzeile").Row > 7 Then zeilevon = Range("Ausdruck_Kopfzeile").Row + 1 zeilebis = Range("Ausdruck_Fußzeile").Row - 1 wksZ.Rows(zeilevon & ":" & zeilebis).Delete End If End Sub

Danke hary,
habe nun diese Variante zusammengestückelt:

Ausdruck_zuruecksetzen()
Dim Start As Long, Ende As Long, AnzZeilen As Long
Start = Sheets("Ausdruck").Range("Start").Row + 1
Ende = Sheets("Ausdruck").Range("Ende").Row - 1
Application.ScreenUpdating = False
For AnzZeilen = Ende To Start Step -1
With Sheets("Ausdruck")
.Rows(AnzZeilen).Delete
End With
Next
Application.ScreenUpdating = True
End Sub

Sub Ausdruck_fuellen()
Dim x As Long, i As Long
x = Sheets("Hilfstabelle_Ausdruck").Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To x
Sheets("Ausdruck").Range("Ende").Insert Shift:=xlDown
Sheets("Ausdruck").Cells(4 + i, 2).Value = Sheets("Hilfstabelle_Ausdruck").Cells(i, 1). _
Value
Sheets("Ausdruck").Cells(4 + i, 3).Value = Sheets("Hilfstabelle_Ausdruck").Cells(i, 2). _
Value
Sheets("Ausdruck").Cells(4 + i, 4).Value = Sheets("Hilfstabelle_Ausdruck").Cells(i, 3). _
Value
Sheets("Ausdruck").Cells(4 + i, 5).Value = Sheets("Hilfstabelle_Ausdruck").Cells(i, 4). _
Value
Sheets("Ausdruck").Cells(4 + i, 6).Value = Sheets("Hilfstabelle_Ausdruck").Cells(i, 5). _
Value
Sheets("Ausdruck").Cells(4 + i, 6).RowHeight = 17
Next i
Sheets("Ausdruck").Range("Hinweis").RowHeight = 55
ResetComments
Application.ScreenUpdating = True
End Sub

Ist zwar sehr langsam die Zellen einzeln abzuklappern, funktioniert aber erst mal.
Dein Code in einer Testmappe auch - aber leider nicht in meiner...
Vic

Sub eintragen() Dim wksQ As Worksheet, wksZ As Worksheet Dim zeilevon As Long, anzahl As Long Set wksQ = Worksheets("Hilfstabelle_Ausdruck") '--Blattname anpassen Set wksZ = Worksheets("Ausdruck") '--Blattname anpassen anzahl = wksQ.Cells(Rows.Count, 2).End(xlUp).Row zeilevon = Range("Hinweis").Row wksZ.Rows(zeilevon + 1 & ":" & zeilevon + anzahl).Insert Shift:=xlDown wksZ.Cells(zeilevon + 1, 2).Resize(anzahl, 5).Value = wksQ.Cells(1, 1).Resize(anzahl, 5) _ .Value wksZ.Cells(zeilevon + 1, 2).Resize(anzahl, 5).RowHeight = 17 Range("Hinweis").RowHeight = 55 End Sub

Sub ZeilenLoeschen() Dim wksZ As Worksheet Dim zeilevon As Long, zeilebis As Long Set wksZ = Worksheets("Ausdruck") '--Blattname anpassen zeilevon = Range("Hinweis").Row + 1 zeilebis = Range("Ende").Row - 1 If zeilebis - zeilevon > 1 Then wksZ.Rows(zeilevon & ":" & zeilebis).Delete End If End Sub

Beliebteste Forumthreads (12 Monate)

Zeilen einfügen zwischen zwei benannten Bereichen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread