Daten finden und kopieren

Hallo zusammen,
ich habe mich in dem Forum angemeldet, da ich mit einer Fragestellung zum Thema VBA an meine Grenzen stoße.
Bei der Fragestellung geht es um einen Schichtplan. Ich habe eine Beispieltabelle angehängt, in der verschiedene Personen aufgeführt sind, die an unterschiedlichen Tagen unterschiedliche Tätigkeiten ausführen. Der Plan umfasst dabei immer ein ganzes Jahr.
Ich möchte mir nun über einen Button die Daten für eine bestimmte KW heraussuchen, diese Daten kopieren und in einem neuen Tabellenblatt einfügen. Das Kopieren und Einfügen ist dabei kein Thema. Die Frage ist eher wie ich bei VBA nach einer bestimmten Kalenderwoche suchen kann und die darunterliegenden Zellen markieren kann.
Ich hoffe ich habe meine Problematik gut genug beschrieben.
Viele Grüße
Dennis04
https://www.herber.de/bbs/user/158237.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub F_en() Dim rng As Range, Wch As Integer Wch = 11 'gesuchte Woche For j = 2 To Cells(2, Columns.Count).End(xlToLeft).Column If Cells(2, j) = Wch Then Columns(j).Copy Sheets(2).Cells(2, Columns.Count).End(xlToLeft).Offset(-1, 1) End If Next j End Sub

Private Sub CommandButton1_Click() Dim a As Long, b As Long KW = InputBox("Woche als Zahl", Kalenderwoche, "1") If Not IsNumeric(KW) Then Exit Sub Select Case Int(KW) Case 1 To 53 a = Application.Match(KW, Rows(2), 0) b = Application.Match(KW, Rows(2), 1) Call Range(Columns(a), Columns(b)).Copy Call Tabelle2.Cells(1, 1).PasteSpecial(Paste:=xlPasteAll) Application.CutCopyMode = False Case Else End Select End Sub

Private Sub CommandButton1_Click() Dim KW As Variant, a As Variant, b As Variant KW = InputBox("Woche als Zahl", Kalenderwoche, "1") If Not IsNumeric(KW) Then Exit Sub Select Case Int(KW) Case 11 To 13 'vorhandene KW-Wochennummern a = Application.Match(CInt(KW), Rows(2), 0) b = Application.Match(CInt(KW), Rows(2), 1) Call Range(Columns(a), Columns(b)).Copy Call Tabelle2.Cells(1, 1).PasteSpecial(Paste:=xlPasteAll) Application.CutCopyMode = False Case Else End Select End Sub

Dim Zelle1 AS range
Dim Zelle2 AS Range
Dim KW AS String
KW =Inputbox(...)
If KW = "" then Exit sub
With Rows(2)
    Set Zelle1 = .Find(what:=KW, lookat:=xlwhole, searchdirection:=xlnext)
    Set Zelle2 = .Find(what:=KW, lookat:=xlwhole, searchdirection:=xlprevious)
End With
If Zelle1 is nothing then
    Msgbox "KW nicht gefunden"
Else
    Intersect(Range(Zelle1, Zelle2).EntireColumn, Range("5:12")).Copy
    Und hier dann das Einfügen
End if

Wenn die KW immer 7 Tage hat, reicht es auch , wenn du nur nach Zelle1 suchst und dann so kopierst

Zelle1.Offset(3, 0).Resize(8, 7).Copy

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten finden und kopieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread