Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1776to1780
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen kopieren aus Autofilter

Zellen kopieren aus Autofilter
31.08.2020 12:41:52
Dennis
Hallo zusammen,
ich bräuchte mal eine kleine Hilfe. In einer Tabelle suche ich nach einem Begriff (kommt nur 1-mal vor). Danach blende ich ein paar Sachen aus, da ich nicht alle Informationen benötige. Die Daten kopiere ich jetzt einzeln in eine Zieltabelle. Einzeln mache ich es, weil in der Zieltabelle verbundene Zellen sind. Das funktioniert auch. Jetzt mein Problem:
Ich will 6 Spalten bzw. Zellen kopieren (hier im Code auf 3 gekürzt), aber es wird 6mal die erste Zelle kopiert. Wo ist mein Fehler?
Wenn eine Beispieldatei benötigt wird, stelle ich gerne eine zur Verfügung.
Vg und danke im voraus!
Sub Kopieren()
Dim lngZeileMax As Integer
Set tp = Worksheets("Übersicht")
Set tv = Worksheets("Daten")
Set tm = Worksheets("Ziel")
With Worksheets("Übersicht")
lngRowMax = .Cells(.Rows.Count, 2).End(xlUp).Row
m = 28
For n = 12 To lngRowMax
If .Cells(n, 12).Value  "" Then
a = Sheet12.Cells(n, 2).Value
Set alldata = tv.Range(tv.Cells(1, 1), tv.Cells(1, 6))
alldata.AutoFilter Field:=2, Criteria1:=a
tv.Columns(2).EntireColumn.Hidden = True
tv.Rows(1).EntireRow.Hidden = True
CustNr = tv.Cells(2, 1).SpecialCells(xlCellTypeVisible).Value
tm.Cells(m, 4) = CustNr
Descrip = tv.Cells(2, 3).SpecialCells(xlCellTypeVisible).Value
tm.Cells(m, 13) = Descrip
Qty = tv.Cells(2, 4).SpecialCells(xlCellTypeVisible).Value
tm.Cells(m, 22) = Qty
ResetAutoFilter
m = m + 2
Else
End If
Next
End With
End Sub

Sub ResetAutoFilter()
Set tp = Worksheets("Daten")
On Error Resume Next
tp.AutoFilterMode = False
tp.Columns(2).EntireColumn.Hidden = False
tp.Rows(1).EntireRow.Hidden = False
tp.ShowAllData
On Error GoTo 0
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen kopieren aus Autofilter
31.08.2020 13:08:43
Rudi
Hallo,
wozu filterst du, wenn der Begriff nur 1x vorkommt? Die Zeile kannst du auch anders ermitteln.
z.B.
Sub Kopieren()
Dim tp As Worksheet, tv As Worksheet, tm As Worksheet
Dim lngRowMax As Long
Set tp = Worksheets("Übersicht")
Set tv = Worksheets("Daten")
Set tm = Worksheets("Ziel")
Dim vntRow
Dim n As Long, m As Long
With tp
lngRowMax = .Cells(Rows.Count, 2).End(xlUp).Row
For n = 12 To lngRowMax
If .Cells(n, 12).Value  "" Then
vntRow = Application.Match(.Cells(n, 2).Value, tv.Columns(2), 0)
If Not IsError(vntRow) Then
tm.Cells(m, 4) = tv.Cells(vntRow, 2)
tm.Cells(m, 13) = tv.Cells(vntRow, 3)
'etc
m = m + 2
End If
End If
Next n
End With
End Sub

Gruß
Rudi
Anzeige
AW: Startwert m = 28 ? o.T.
31.08.2020 13:12:28
Gerd
Gruß Gerd
jepp! vergessen. owT
31.08.2020 13:34:40
Rudi
AW: jepp! vergessen. owT
31.08.2020 14:59:54
Dennis
Vielen Dank. Klappt super. An die Match-Funtkion hab ich nicht gedacht.
oder .FIND-Methode owT
31.08.2020 15:19:36
Rudi
AW: oder .FIND-Methode owT
31.08.2020 16:37:58
Dennis
Hallo Rudi,
habe noch eine Frage. Habe versucht die Formel nachzuvollziehen, aber kannst du mir nochmal kurz die folgeende Zeile erklären?
vntRow = Application.Match(.Cells(n, 2).Value, tv.Columns(2), 0)
AW: oder .FIND-Methode owT
31.08.2020 16:48:19
Rudi
sucht den Wert aus tp Zelle n,2 in tv Spalte2
Wenn er nicht gefunden wird, gibt vntRow einen Fehler zurück ansonsten die Zeile.

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige