Datum

Titel

20.04.2024 15:30:14

Warum Verweis zeigt Falsch an

20.04.2024 14:03:38

Http-Request (POST) für GraphQL API-Abfrage

20.04.2024 08:56:18

Textbox in Tabellenblatt ohne Bestätigung in Zelle eintragen

20.04.2024 07:57:54

Tablle fürs E-Auto - Preis wenn kürzer als 60 Min Ladezeit

Du findest keine passende Antwort auf Deine Frage?

Stelle Deine Frage in unserem Live-Forum

Archiv - Navigation

1600to1604

Aktuelles Verzeichnis

Verzeichnis Index

Übersicht Verzeichnisse

Vorheriger Thread

Rückwärts Blättern

Nächster Thread

Vorwärts blättern

HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Vorwärts blättern

Inhaltsverzeichnis

Bestimmten Bereich kopieren und einfügen

Forumthread: Bestimmten Bereich kopieren und einfügen
11 Beiträge zu diesem Forumthread
Anzeige
346 Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen

Top 100 Forumthreads

12.01.2018 08:01:59

Sven

Guten Morgen,
ich bräuchte ein Makro, welches mir alle befüllten Zeilen, aus Reiter nur Funktion (ab Zeile 9 bis zur letzten beschriebenen Zeile) kopiert und nur die Werte in Reiter Alles, in die erste freie Zeile kopiert.
Da ich mir den Reiter nur Funktionen schon durch ein anderes Makro in die Datei hole und dieser Reiter mehrfach vorkommen kann (nur Funktion (2), nur Funktion (3), ..), stellt sich auch die Frage ob man das Makro so schreiben kann, dass alle Daten aus den unterschiedlichen Reitern kopiert werden können. Die Anzahl der Reiter ist variabel.
Anbei noch eine Testdatei.
https://www.herber.de/bbs/user/118891.xlsx
Gruß
Sven

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Nachfrage

12.01.2018 08:11:06

Werner
AW: Nachfrage

12.01.2018 08:19:33

Sven
AW: Nachfrage

12.01.2018 08:57:57

Werner
AW: Nachfrage

12.01.2018 09:21:12

Sven
AW: Nachfrage

12.01.2018 09:46:22

Werner
AW: Nachfrage

12.01.2018 10:11:52

Sven
AW: Nachfrage

12.01.2018 10:17:15

Sven
AW: Nachfrage

12.01.2018 10:32:33

Sven
AW: Nachfrage

12.01.2018 10:43:52

Werner
AW: Nachfrage

12.01.2018 11:35:05

Sven
Gerne u. Danke für die Rückmeldung. o.w.T.

12.01.2018 11:38:02

Werner

Nachfrage

12.01.2018 08:11:06

Werner

Hallo Sven,
in deiner Beispieldatei sind in den Blättern Funktionen die Daten gefiltert. Soll nur das jeweilige Filterergebnis oder der gesamte Datenbestand kopiert werden?
Gruß Werner

AW: Nachfrage

12.01.2018 08:19:33

Sven

Guten Morgen Werner,
es sollen nur die gefilterten Daten kopiert werden.
Gruß Sven

AW: Nachfrage

12.01.2018 08:57:57

Werner

Hallo Sven,
in beiden "Funktion" Blättern ist in Spalte C unterhalb des eigentlichen Datenbereichs jeweils noch ein Wert eingetragen, wobei die Schriftfarbe auf die Hintergrundfarbe gesetzt ist. Was hat es denn damit auf sich?
Gruß Werner

AW: Nachfrage

12.01.2018 09:21:12

Sven

Hallo Werner,
in der Originaldatei stehen in dieser Zeile noch wichtige Infos und wenn durch den Filter in Spalte C nach dem Wert 100 gefiltert wird, wären diese nicht mehr sichtbar deshalb wurde hier auch nochmal die 100 eingetragen. Für die Kopierfunktion kann dies vernachlässigt werden.

AW: Nachfrage

12.01.2018 09:46:22

Werner

Hallo Sven,
dann teste mal:

Public Sub Daten_sammeln()
Dim oFilter As Filter, boGefiltert As Boolean
Dim wsQuelle As Worksheet, wsZiel As Worksheet
Dim loLetzteQuelle As Long
Set wsZiel = ThisWorkbook.Worksheets("Alles")
Application.ScreenUpdating = False
For Each wsQuelle In ThisWorkbook.Worksheets
If wsQuelle.Name Like "nur Funktion*" Then
With wsQuelle
If .AutoFilterMode Then
For Each oFilter In .AutoFilter.Filters
If oFilter.On Then
boGefiltert = True
Exit For
End If
Next
End If
If boGefiltert Then
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 2).Copy
wsZiel.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues
Application.CutCopyMode = False
boGefiltert = False
Else
loLetzteQuelle = .Cells(.Rows.Count, 3).End(xlUp).Offset(-1, 0).Row
.Range(.Cells(9, 1), .Cells(loLetzteQuelle, 5)).Copy
wsZiel.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues
Application.CutCopyMode = False
End If
End With
End If
Next wsQuelle
Set wsZiel = Nothing
Application.ScreenUpdating = True
End Sub

Gruß Werner

AW: Nachfrage

12.01.2018 10:11:52

Sven

Hallo Werner,
funktioniert echt super, vielen Dank.
Eine kleine Frage hätte ich noch und zwar kann ich dieses Makro für weitere Aufgaben benötigen müsste hierfür aber z.B. nicht ab Spalte 9 sondern z.B. ab Spalte 10 oder 20 anfangen zu kopieren. Wie müsste ich das Makro hierfür abändern?
Ich habe schon versucht bei folgender Position die 9 auf 10 abzuändern dies funktioniert aber leider nicht.
Else
loLetzteQuelle = .Cells(.Rows.Count, 3).End(xlUp).Offset(-1, 0).Row
.Range(.Cells(9, 1), .Cells(loLetzteQuelle, 5)).Copy
Gruß Sven

AW: Nachfrage

12.01.2018 10:17:15

Sven

Hallo Werner,
eins ist mir noch aufgefallen, wäre es auch möglich die komplette Zeile zu kopieren.

AW: Nachfrage

12.01.2018 10:32:33

Sven

Hallo Werner,
jetzt hab ich es doch Verstanden, dein Makro kopiert alle Werte, welche gefiltert werden.
Müsste meine Ausgangsdaten so anpassen können, dass es funktioniert, nochmals vielen Dank ist eine echte Erleichterung.
Gruß Sven

AW: Nachfrage

12.01.2018 10:43:52

Werner

Hallo Sven,
das wolltest du doch so, deshalb habe ich ja nachgefragt.
Wenn die Blätter gefiltert sind, dann wird das Filterergebnis kopiert.
Wenn die Blätter nicht gefilter sind, dann wird alles kopiert.
Um die ganze Zeile zu kopieren, dann die beiden Codezeilen mit dem Copy Befehl so ändern:

.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 2).EntireRow.Copy
.Range(.Cells(9, 1), .Cells(loLetzteQuelle, 5)).EntireRow.Copy

Und zu deiner Frage bezüglich Änderung/Anpassung:
bei der Cells-schreibweise gibt die erste Zahl in der Klammer die Zeilennummer wieder und die zweite Zahl in der Klammer die Spaltennummer.
Beispiel: Cells(1, 1) =A1 / Cells(2, 1) =A2 / Cells(1, 2) =B1
Gruß Werner

AW: Nachfrage

12.01.2018 11:35:05

Sven

Perfekt, nun funktioniert alles, Danke
Gruß Sven

Gerne u. Danke für die Rückmeldung. o.w.T.

12.01.2018 11:38:02

Werner