Sollen Daten aus einer Tabelle kopiert und in eine gefilterte
Tabelle eingefügt werden, so bietet Excel hierfür keine geeignete Möglichkeit. Ausgeblendete Zeilen werden ebenfalls überschrieben.

Hier nun der Versuch mittels Makro diese Funktionalität umzusetzen.

 

Gewünschte Daten kopieren -> zur gefilterten Tabelle wechseln -> Zielzelle anklicken und die Daten in die sichtbaren Zeilen einfügen.

 

Das Makro muss per Tastenkombination ( eine Schaltfläche macht hier wohl weniger Sinn ) ausgeführt werden.

Siehe auch Programmierung -> Makro eine Tastenkombination zuweisen.

 

Wird der Code in die PERSONL.XLS eingefügt, so steht die Funktion in jeder Datei zur Verfügung.

 

Diese Beispieltabelle wird nach Kategorie A in der ersten Spalte gefiltert.

 

 

 

 

 

 

 

Aus einer anderen Tabelle werden nun Daten kopiert

 

 

 

 

und ab Zelle B2 eingefügt.

 

 

 

 

Das Ergebnis nach Codeausführung und öffnen des Autofilters.

Die Anzahl der kopierten Spalten wird im Code ermittelt. Werden mehr Zeilen kopiert als gefltert sind, so werden die restlichen unten angefügt.

 

 

Der Code für ein allgemeines Modul.

Unter Extras - Verweise muss die Microsoft Forms 2.0 Object Library eingebunden sein.

 

 

Public Sub Daten_in_gefilterte_Zeilen_einfügen()

'#################################################################

'Code für ein allgemeines Modul

'Unter Extras -> Verweise ist ein Häkchen bei "Microsoft Forms 2.0 Object Library" gesetzt!

'Code fügt Daten in sichtbare Zeilen einer gefilterten Tabelle ein

'Autor: Jürgen Hennekes

'#################################################################

On Error Resume Next

Dim objZA As New DataObject

Dim SPL1 As Variant

Dim SPL2 As Variant

Dim lngZ As Long

Dim lngZZ As Long

Dim intI As Integer

Dim intS As Integer

Dim strText As String

 

objZA.GetFromClipboard

strText = objZA.GetText

If Err.Number <> 0 Then

  MsgBox "Es wurden keine Daten kopiert!", 48

  Exit Sub

End If

 

lngZZ = ActiveCell.Row

intS = ActiveCell.Column

SPL1 = Split(strText, Chr(10))

 

For lngZ = 0 To UBound(SPL1) - 1

  For lngZZ = lngZZ To 65536

    If Cells(lngZZ, intS).EntireRow.Hidden = False Then

      SPL2 = Split(SPL1(lngZ), Chr(9))

      For intI = 0 To UBound(SPL2)

        Cells(lngZZ, intS + intI).Value = _

        LTrim(RTrim(WorksheetFunction.Proper(Replace(SPL2(intI), Chr(13), ""))))

      Next

      lngZZ = lngZZ + 1

      Exit For

    End If

  Next

Next

 

End Sub