Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1912to1916
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

Bereich (mit Kriterium) kopieren

Bereich (mit Kriterium) kopieren
09.01.2023 16:28:09
Fred
Hallo Excel Experten,
ich stehe mal wieder vor einer für mich unlösbaren Aufgabe,- die allerdings nicht so schwer erscheint.
Ich habe in Sheet "Ansicht1, I3" einen Wert
In Sheet "Auswahl1" eine gefilterte formatierte Tabelle ("tab_Auswahl1"), in dieser form. Tabelle sind u.a. die SpaltenÜberschriften (Zeile 10) von 1 bis 90
Ich möchte;
das aufgrund des Wertes (Ansicht1, I3) die gefilterten Zeilenbereiche der TabellenspaltenNamen
Wert von I3 minus 5
Wert von I3 plus 10
markiert, kopiert und nach Sheet "Ansicht1, D9" eingefügt
ALSO: Wenn in Sheet (Ansicht1, I3) steht 40
dann kopiere den gefilt. Zeilenbereich der form. Tabelle (tab_Auswahl1) mit den Überschriften 35 bis 50 nach "Ansicht1"
hier ein vereinfachtes Beispiel:
https://www.herber.de/bbs/user/157177.xlsb
Kann ein Experte bitte mal drauf schauen und mir eine VBA Lösung anbieten?
Gruss
Fred

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich (mit Kriterium) kopieren
09.01.2023 16:55:44
UweD
Hallo
so?

Sub Kopieren()
Dim TB1 As Worksheet, TB2 As Worksheet
Dim Z1 As Integer, LR As Long, SP As Integer
Dim Zelle As String, RNG As Range, Such As String
Set TB1 = Sheets("Ansicht1")
Set TB2 = Sheets("Auswahl1")
Zelle = "I3"
Z1 = 10
Such = Tb1.Range(Zelle)
LR = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes
If WorksheetFunction.CountIf(TB2.Rows(Z1), Such) > 0 Then
SP = WorksheetFunction.Match(Such, TB2.Rows(Z1), 1)
Set RNG = TB2.Cells(Z1 + 1, SP - 5).Resize(LR - Z1 + 1, 15)
RNG.SpecialCells(xlCellTypeVisible).Copy Tb1.Range("D9")
End If
End Sub
LG UweD
Anzeige
AW: Bereich (mit Kriterium) kopieren
09.01.2023 17:12:37
Fred
Hallo UweD
vielen Dank für deine Aufmerksamkeit und Kompetenz!
Obwohl ich es bei meiner Anfrage nicht richtig formuliert habe (" mit den Überschriften 35 bis 50 nach ...) hast du es wie gewünscht hinbekommen.

Resize(LR - Z1 + 1, 15)
mußte noch in

Resize(LR - Z1 + 1, 16)
geändert werden.
Der Code sieht eigentlich doch aufwendiger aus als ich dachte :-)
Nochmals vielen Dank!
Gruss
Fred

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige