Willkommen

Pivottabelle

Spezialfilter

Formeln

Zellformate

Bedingte Formate

Gültigkeit

Programmierung

UDF - Funktionen

Tipps & Tricks

Webabfrage

Fehlersuche

Farbindex

Shortcuts

Limitationen

Downloads

Links

Kontakt

Disclaimer

Impressum

Einfügen in einen gefilterten Bereich
 
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