Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1600to1604
1600to1604
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilen automatisch kopieren

Forumthread: Zeilen automatisch kopieren

Zeilen automatisch kopieren
22.01.2018 16:36:58
Daniel
Hallo zusammen
Ich habe folgende Excel Arbeitsmappe mit zwei Tabellen drin. 1. Händlerübersicht und 2. Auswertung Bedingung 18.
https://www.herber.de/bbs/user/119163.xlsx
Ich benötige eure Hilfe, weil ich nun die Tabelle Händlerübersicht in Spalte D (Art) nach dem Buchstaben C und C2 durchsuchen will und wenn einer dieser Buchstaben gefunden worden ist, sollen bestimmte Zellen in die Tabelle Auswertung Bedingung 18 kopiert werden. Die zu kopierenden Zellen sind in der Tabelle Auswertung Bedingung 18 zu sehen.
Zusätzlich müsste ich noch einen Button haben, der es mir ermöglich die letzten 50 Zeilen der Tabelle Auswertung Bedingung 18 zu drucken (die erste Zeile und die letze Zeile der 50iger Serie werden in O3 und P3 angezeigt). Und ein Button, der es ermöglich die letzten 50 Zeilen in eine neue Arbeitsmappe zu exportieren.
Könnt Ihr mir helfen so etwas zu erstellen?
Vielen Dank für eure Mühe.
Gruss Daniel
Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nachfrage
22.01.2018 20:12:22
Werner
Hallo Daniel,
sollen denn die Daten im Blatt Auswertung Bedingung 18 überschrieben werden oder soll jeweils am Ende angefügt werden.
Gruß Werner
AW: Nachfrage
22.01.2018 20:31:34
Daniel
Hallo Werner
Die Daten sollen jeweils unten angefügt werden. So dass die bestehenden Daten erhalten bleiben.
Gruss Daniel
AW: Nachfrage
22.01.2018 20:35:05
Daniel
Hallo Werner
Die Daten sollen jeweils unten angefügt werden. So dass die bestehenden Daten erhalten bleiben.
Gruss Daniel
Anzeige
erster Teil
22.01.2018 21:55:02
Werner
Hallo Daniel,
hier mal der erste Teil. Quelltabelle nach C und C2 filtern, Filterergebnis in Zieltabelle kopieren. 
Option Explicit
Public Sub Filtern_kopieren()
Dim loSpalteQ As Long, loZeileQ As Long, loLetzteZ As Long
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = ThisWorkbook.Worksheets("Händlerübersicht")
Set wsZ = ThisWorkbook.Worksheets("Auswertung Bedingung 18")
Application.ScreenUpdating = False
With wsQ
loZeileQ = .Cells(.Rows.Count, 2).End(xlUp).Row
loSpalteQ = .Cells(1, .Columns.Count).End(xlToLeft).Column
loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Offset(1, 0).Row
.Range(.Cells(1, 1), .Cells(loZeileQ, loSpalteQ)).AutoFilter Field:=4, _
Criteria1:="=C", Operator:=xlOr, Criteria2:="=C2"
.AutoFilter.Range.Columns("K:K").Offset(1).Resize(.AutoFilter.Range.Columns("K:K") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 2).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("G:H").Offset(1).Resize(.AutoFilter.Range.Columns("G:H") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 4).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("J:J").Offset(1).Resize(.AutoFilter.Range.Columns("J:J") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 6).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("I:I").Offset(1).Resize(.AutoFilter.Range.Columns("I:I") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 7).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("AC:AC").Offset(1).Resize(.AutoFilter.Range.Columns("AC:AC") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 8).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("AB:AB").Offset(1).Resize(.AutoFilter.Range.Columns("AB:AB") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 9).PasteSpecial Paste:=xlValues
If .AutoFilterMode Then .ShowAllData
End With
With wsZ
loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(loLetzteZ, 1)).FormulaLocal = "=KALENDERWOCHE(B2)"
.Range(.Cells(2, 1), .Cells(loLetzteZ, 1)).Value = _
.Range(.Cells(2, 1), .Cells(loLetzteZ, 1)).Value
.Range(.Cells(2, 3), .Cells(loLetzteZ, 3)).FormulaLocal = "=TEXT(B2;""TTT"")"
.Range(.Cells(2, 3), .Cells(loLetzteZ, 3)).Value = _
.Range(.Cells(2, 3), .Cells(loLetzteZ, 3)).Value
End With
Set wsQ = Nothing: Set wsZ = Nothing
Application.ScreenUpdating = True
End Sub
Rest kommt noch. Ob es mir heute noch reicht kann ich nicht sagen.
Gruß Werner
Anzeige
AW: Nachfrage
22.01.2018 22:19:37
Werner
Hallo Daniel,
hier das Makro zum Drucken. 
Public Sub Drucken()
With Worksheets("Auswertung Bedingung 18")
If .Cells(3, 15)  "" And .Cells(3, 16)  "" Then
If IsNumeric(.Cells(3, 15).Value) And IsNumeric(.Cells(3, 16).Value) Then
.Range(.Cells(.Cells(3, 15), 1), .Cells(.Cells(3, 16), 9)).PrintOut
Else
MsgBox "Werte für Druckbereich nicht numerisch."
End If
Else
MsgBox "Es wurde kein Durckbereich angegeben."
End If
End With
End Sub
Ich bin mal davon ausgegangen, dass bis Spalte I gedruckt werden soll.
Gruß Werner
Anzeige
AW: Nachfrage
22.01.2018 22:46:47
Daniel
Hallo Werner
Ja, bis Spalte I.
Vielen Dank für Deine Mühe. Die Umsetzung ist super.
Gruss Daniel
AW: Nachfrage
22.01.2018 22:54:57
Werner
Hallo Daniel,
hier noch mal das Makro zum Drucken. Ich habe jetzt erst festgestellt, dass du ja in Zelle P3 die letzte belegte Zeile ermittelst. Die hatte ich in mein Makro eingebaut, was dann so nicht stimmt.
Jetzt anders. Bei dem Makro brauchst du weder die erste Druckzeile noch die letzte Druckzeile zu erfassen. Es genügt in die Zelle Q3 die Anzahl der zu druckenden Zeilen einzutragen. 
Public Sub Drucken()
Dim loLetzte As Long, loAnzahl As Long
With Worksheets("Auswertung Bedingung 18")
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(3, 17)  "" And IsNumeric(.Cells(3, 17).Value) Then
loAnzahl = .Cells(3, 17)
If loLetzte - loAnzahl
Makro zum exportieren in eine Datei kommt noch. Da hätte ich dann aber noch eine Frage. Willst du das in einen vorgegebenen Pfad mit festgelegtem Dateinamen machen oder über das speichern Menü von Excel. Bei feststehendem Pfad wäre es nicht schlecht, wenn ich den hätte.
Dann noch ne Frage zum ersten Makro Filtern_kopieren, läuft das wie gewünscht?
Gruß Werner
Anzeige
AW: Nachfrage
22.01.2018 23:14:38
Daniel
Hallo Werner
Okey, vielen Dank für die Verbesserung. Das erste Makro habe ich nur mal kurz getestet und es funktionierte zu vollster Zufriedenheit.
Für den Export würde ich die variable Methode (speichern unter) bevorzugen.
Gruss Daniel
AW: Nachfrage
23.01.2018 02:01:59
Werner
Hallo Daniel,
teste mal: 
Public Sub Blatt_speichern()
Dim loLetzte As Long, loAnzahl As Long
Dim varDatei As Variant
Application.ScreenUpdating = False
With Worksheets("Auswertung Bedingung 18")
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(3, 17)  "" And IsNumeric(.Cells(3, 17).Value) Then
loAnzahl = .Cells(3, 17)
If loLetzte - loAnzahl
Übrigens beim letzten Druck-Makro mußt du natürlich hier: 
.Range(.Cells(loLetzte - loAnzahl + 1, 1), .Cells(loLetzte, 9)).Select

das .Select durch .Printout ersetzen.
Gruß Werner
Anzeige
AW: Nachfrage
23.01.2018 09:42:14
Daniel
Hallo Werner
Vielen Dank nochmals für die tolle Arbeit. Heute habe ich alles ausführlich getestet. Eine "Kleinigkeit" ist mir noch aufgefallen. Ist es möglich beim Makro Filtern_kopieren() es so zu programmieren, dass wenn man es zweimal nacheinander ausführt, bei zweiten mal nur die Einträge kopiert werden, die neu dazugekommen sind?
Gruss Daniel
Anzeige
AW: Nachfrage
23.01.2018 13:17:34
Werner
Hallo Daniel,
an was kann ich festmachen, wann ein Datensatz doppelt vorhanden ist und gelöscht werden kann?
Ist die Spalte mit der ID dafür geeignet? Oder kann es auch dazu kommen, dass doppelt vorkommende ID vorhanden sind, die aber nicht als Doppeleinträge gelten sollen?
Gruß Werner
Anzeige
AW: Nachfrage
23.01.2018 15:01:03
Daniel
Hallo Werner
Jede ID-Nummer wird es nur einmal geben.
Gruss Daniel
AW: Nachfrage
23.01.2018 15:07:44
Werner
Hallo Daniel,
dann mit RemoveDuplicates, ist eine eizige Codzeile mehr. 
Option Explicit
Public Sub Filtern_kopieren()
Dim loSpalteQ As Long, loZeileQ As Long, loLetzteZ As Long
Dim wsQ As Worksheet, wsZ As Worksheet
Set wsQ = ThisWorkbook.Worksheets("Händlerübersicht")
Set wsZ = ThisWorkbook.Worksheets("Auswertung Bedingung 18")
Application.ScreenUpdating = False
With wsQ
loZeileQ = .Cells(.Rows.Count, 2).End(xlUp).Row
loSpalteQ = .Cells(1, .Columns.Count).End(xlToLeft).Column
loLetzteZ = wsZ.Cells(wsZ.Rows.Count, 2).End(xlUp).Offset(1, 0).Row
.Range(.Cells(1, 1), .Cells(loZeileQ, loSpalteQ)).AutoFilter Field:=4, _
Criteria1:="=C", Operator:=xlOr, Criteria2:="=C2"
.AutoFilter.Range.Columns("K:K").Offset(1).Resize(.AutoFilter.Range.Columns("K:K") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 2).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("G:H").Offset(1).Resize(.AutoFilter.Range.Columns("G:H") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 4).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("J:J").Offset(1).Resize(.AutoFilter.Range.Columns("J:J") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 6).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("I:I").Offset(1).Resize(.AutoFilter.Range.Columns("I:I") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 7).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("AC:AC").Offset(1).Resize(.AutoFilter.Range.Columns("AC:AC") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 8).PasteSpecial Paste:=xlValues
.AutoFilter.Range.Columns("AB:AB").Offset(1).Resize(.AutoFilter.Range.Columns("AB:AB") _
.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsZ.Cells(loLetzteZ, 9).PasteSpecial Paste:=xlValues
If .AutoFilterMode Then .ShowAllData
End With
With wsZ
loLetzteZ = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(loLetzteZ, 1)).FormulaLocal = "=KALENDERWOCHE(B2)"
.Range(.Cells(2, 1), .Cells(loLetzteZ, 1)).Value = _
.Range(.Cells(2, 1), .Cells(loLetzteZ, 1)).Value
.Range(.Cells(2, 3), .Cells(loLetzteZ, 3)).FormulaLocal = "=TEXT(B2;""TTT"")"
.Range(.Cells(2, 3), .Cells(loLetzteZ, 3)).Value = _
.Range(.Cells(2, 3), .Cells(loLetzteZ, 3)).Value
.Range("$A$1:$I$" & loLetzteZ).RemoveDuplicates Columns:=6, Header:=xlYes
End With
Set wsQ = Nothing: Set wsZ = Nothing
Application.ScreenUpdating = True
End Sub
Gruß Werner
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige