Daten ohne überschreiben in Tabelle einfügen

Hallo zusammen und ein frohes neues Jahr,
ich habe eine Tabelle in Excel (also dass, was Excel Tabelle nennt). In diese Tabelle fülle ich Meldungen von externen Dienstleistern und unsere Bearbeitungsvermerke ein. Das alles geschieht per Copy & Paste aus einer anderen Anwendung. Danach erstelle ich mit anderen Formeln und Auswertungen hieraus einen Bericht für uns.
Es tritt häufiger auf, dass ich unsere Bearbeitunsmeldungen erst nachträglich einstellen kann. Hierzu möchte ich per VBA die Möglichkeit schaffen, dass Excel
1. ... die Daten ohne überschreiben in die Tabelle einfügt. Es müsste also geprüft werden, wieviele Zeile aus der Zwischenablage kommen und entsprechend viele Zeile in die Tabelle eingefügt werden. Alternativ könnten auch z. B. 10 Zeilen pauschal erstellt, der Inhalt hineinkopiert und die leeren Zeilen dann gelöscht werden.
2. ... die erste Zeile dieser "Einfügung" müsste wieder gelöscht werden, weil hier immer die Spaltenüberschriften der Datenquelle aufgeführt werden. Dies könnte m. E. entwender gehen, wenn Excel die Einfügeposition nutzen kann (als die Zeile, in der die neuen Daten beginnen) oder indem die Überschrift erkannt wird (beginnt immer mit "Einsteller").
Da an meiner "echten Datei" noch einige Formeln für weitere Auswertungen hängen, kann ich die Sache leider nicht anders darstellen.
Ich hoffe, ich habe mein Problem verständlich machen können, ansonsten schickt mir Unklarheiten bitte. Als Muster habe ich hier eine Datei für Euch: https://www.herber.de/bbs/user/94693.xlsx
Besten Dank
Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Makro in einem allgemeinen Modul Sub ExterneInhalteEinfuegen() Dim wks As Worksheet Dim Zeile As Long, Zeile2 As Long Set wks = ActiveSheet Zeile = ActiveCell.Row If MsgBox("Inhalt aus Zwischenablage ab Zeile """ & Zeile & """ einfügen?") = vbOK Then With wks '10 Leerzeilen einfügen .Range(.Rows(Zeile), .Rows(Zeile + 9)).Insert 'Einfügezelle selektieren .Cells(Zeile, 1).Select 'Daten einfügen ActiveSheet.Paste 'leere Zeilen und 1. Zeile wieder löschen For Zeile2 = Zeile + 9 To Zeile Step -1 If .Cells(Zeile2, 2) = "" Or Zeile2 = Zeile Then .Rows(Zeile2).Delete shift:=xlShiftUp End If Next 'Einfügezelle wieder selektieren .Cells(Zeile, 1).Select End With End If End Sub

Hallo Franz,
super, das klappt. Ich hab noch ein bischen an dem Makro rumgeschraubt und es meiner Datei angepasst. Sie sieht es jetzt aus:

'Makro in einem allgemeinen Modul
Sub ExterneInhalteEinfuegen()
Dim wks As Worksheet
Dim Zeile As Long, Zeile2 As Long
Set wks = ActiveSheet
Zeile = ActiveCell.Row
'Entsperren
ActiveSheet.Unprotect "*****"
On Error Resume Next
Application.Run "Bildschirmaktualisierung_ausschalten"
If MsgBox("Inhalt aus Zwischenablage unter Zeile """ & Zeile & """ einfügen?", vbOKCancel) = _
vbOK Then
With wks
'5 Leerzeilen einfügen
.Range(.Rows(Zeile + 1), .Rows(Zeile + 5)).Insert
'Einfügezelle selektieren
.Cells(Zeile + 1, 1).Select
'Daten einfügen
ActiveSheet.Paste
'leere Zeilen und 1. Zeile wieder löschen
For Zeile2 = Zeile + 5 To Zeile Step -1
If .Cells(Zeile2, 4) = "" Or Zeile2 = Zeile + 1 Then
.Rows(Zeile2).Delete Shift:=xlUp
End If
Next
End With
'wenn Cancel, Prozedur verlassen
Else
Exit Sub
End If
'Formel aus Spalte Status, Zeile 2 nach unten kopieren und so wieder aktualisieren
'Ausgangsformel in Zwischenablage
Range("Q2").Select
'In Spalte Status einfügen
Selection.Copy
Selection.AutoFill Destination:=Range("Tabelle2[Status]"), Type:= _
xlFillDefault
'Zelle über Einfügezeile,Spalte Status wieder selektieren
wks.Cells(Zeile, 16).Select
'Optimale Zeilenhöhe
Application.Run "Optimale_Höhe"
'Schutz einstellen
ActiveSheet.Protect "*****"
Application.Run "Bildschirmaktualisierung_einschalten"
End Sub

Besten Dank
Frank

Private Sub CommandButton1_Click() Dim r As Long Dim c As Long Dim z As Long Dim sf() As String With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") .GetFromClipboard sf() = Split(.GetText, vbCrLf) End With r = ActiveCell.Row + 1 c = ActiveCell.Column z = r + UBound(sf) With Tabelle1 .Range(.Rows(r), .Rows(z)).Insert .Range(Cells(r, c), Cells(z, c)) = WorksheetFunction.Transpose(sf()) .Range(.Rows(r), .Rows(r)).Delete End With End Sub

Beliebteste Forumthreads (12 Monate)

Daten ohne überschreiben in Tabelle einfügen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten ohne überschreiben in Tabelle einfügen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

318 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread