Spaltenabfrage und Kopieren auf neues Blatt

Guten Abend liebes Forum,
ich bin noch ziemlich unerfahren was VBA angeht und hab mir dafür glaub ich ziemlich viel vorgenommen. Da ich aber absolut nicht weis wo ich anfangen soll und auch nichts an Code dazu habe, frag ich nun Euch und bitte um Eure Unterstützung.
Es geht um folgendes: Ich habe eine Datenbank, in der unregelmäßig zu einigen Namen werte mit Datum gespeichert werden. Der VBA Code soll nun (am besten via Input-Box) zu dem gewünschten Namen die entsprechenden Werte mit dem jeweiligen Datum auf ein neues Blatt kopieren, und zwar wenn möglich nicht nebeneinander, sondern untereinander (heißt: Datum und Name, dann neue Zeile und da wieder Datunm und Name, usw. bis alle entsprechenden Werte auf dem Sheet sind) damit ich dann die Differenz zum Vormonat/Zeitraum ausrechnen und die Ergebnisse schön in eine Grafik packen kann. All das sollte per Mausklick und Input-Box klappen. Da aber im Laufe der Zeit neue Personen und ihre Werte hinzukommen, sollte bzw. muss jede Namensspalte jeweils getestet werden, bevor Datum und Name kopiert werden.
Also schon einiges, was der Code machen muss.
Ich hoffe, dass Ihr mir hier weiterhelfen könnt.
Hier sind noch die Bsp. zum Ausgangssheet:
Userbild

https://www.herber.de/bbs/user/132831.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

ok, dann teste mal den folgenden Code:


Public Sub Uebertrag()
Dim obj_wks_ziel As Worksheet
Dim obj_wks_quelle As Worksheet
Dim lng_spalte As Long
Dim lng_letzte_spalte As Long
Dim lng_letzte_zeile_quelle As Long
Dim lng_letzte_zeile_ziel As Long
Dim lng_zeile As Long
Dim str_name As String
str_name = InputBox("Auswertung für?")
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = str_name
Set obj_wks_ziel = ActiveSheet
obj_wks_ziel.Range("A1") = "Name"
obj_wks_ziel.Range("A1") = "Datum"
obj_wks_ziel.Range("A1") = "Wert"
lng_letzte_zeile_ziel = 2
Set obj_wks_quelle = ThisWorkbook.Worksheets("Tabelle1")  ' Hier Quelltabellenblatt ggf.  _
benennen
With obj_wks_quelle
lng_letzte_spalte = .Cells(1, Columns.Count).End(xlToLeft).Column
For lng_spalte = 1 To lng_letzte_spalte - 2 Step 3
lng_letzte_zeile_quelle = .Cells(Rows.Count, lng_spalte).End(xlUp).Row
For lng_zeile = 1 To lng_letzte_zeile_quelle
If .Cells(lng_zeile, lng_spalte) = str_name Then
.Cells(lng_zeile, lng_spalte).Copy obj_wks_ziel.Cells(lng_letzte_zeile_ziel, 1)
.Cells(lng_zeile, lng_spalte + 1).Copy obj_wks_ziel.Cells(lng_letzte_zeile_ziel, _
2)
.Cells(lng_zeile, lng_spalte + 2).Copy obj_wks_ziel.Cells(lng_letzte_zeile_ziel, _
3)
lng_letzte_zeile_ziel = lng_letzte_zeile_ziel + 1
End If
Next
Next
End With
End Sub

Gruß
Regina

Beliebteste Forumthreads (12 Monate)

Spaltenabfrage und Kopieren auf neues Blatt

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spaltenabfrage und Kopieren auf neues Blatt

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

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread