Mehrere Tabellenblätter in neues Kopiere

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Marco,
... dass ich auch eine Formellösung angeboten hatte. Diese könnte z.B. wie folgt vorgenommen werden.
In z.B. I4:I9 schreibe Deine Tabellenblattnamen und in H4 dann eine 1
Die Formel H5 kopiere ziehend bis H10. Die Formel C5 mit dem Datum als Zellenformat: Datum nach unten und nach rechts.
Siehe:

Arbeitsblatt mit dem Namen 'Abgelaufene'
	A	B	C	D	E	F	G	H	I
2
3									Tabellenblatt
4	Nr.	Name	Abgelaufen/läuft ab am					1	A - E
5	1	Name_01	17.12.2020					5	F - Hog
6	2	Name_02	21.02.2024					9	Hoh - K
7	3	Name_03	30.04.2026					14	L - R
8	4	Name_04	21.10.2019					16	S - T
9	5	Name_11	19.05.2025					20	V - Z
10	6	Name_12	30.09.2026					23
11	7	Name_13	31.12.2023
12	8	Name_14	16.05.2020
13	9	Name21	18.09.2023

Zelle	Formel
C5	=WENNFEHLER(INDEX(INDIREKT("'"&SVERWEIS(ZEILE(B1);$H:$I;2)&"'!A:C");ZEILE()-SVERWEIS(ZEILE(B1);$H:$H;1)+1;SPALTE());"")
H5	=INDIREKT("'"&I4&"'!H1")+H4

Verwendete Systemkomponenten: [Windows (32-bit) NT 6.02] MS Excel 2010

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

Gruß Werner
.. , - ...

Hallo
Die Daten in der Zieltabelle werden automatisch aktualisiert (gelöscht und einzeln wieder eingelesen) wenn das Blatt aktiviert wird.
Dazu bitte:
- Rechtsclick auf den Tabellenblattreiter von "Abgelaufene"
- Code anzeigen
- Diesen Code dort reinkopieren


Private Sub Worksheet_Activate()
Dim TB As Worksheet
Dim LRx As Integer, LR As Integer
Dim Z1 As Integer, ZZ As Integer, i As Integer
Z1 = 5 'Erste Zeile mit Daten
'reset
LR = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
Me.Cells(Z1, 2).Resize(LR - Z1 + 1, 2).ClearContents
ZZ = Z1
For Each TB In ThisWorkbook.Sheets
If TB.Name  Me.Name Then
LRx = TB.Cells(TB.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte
For i = Z1 To LRx
If Year(TB.Cells(i, 3)) = Year(Date) Or Year(TB.Cells(i, 3)) = Year(Date) - 1 Then
'kopieren
TB.Cells(i, 2).Resize(1, 2).Copy Me.Cells(ZZ, 2).Resize(1, 2)
ZZ = ZZ + 1
End If
Next
End If
Next
End Sub

LG UweD

Private Sub Worksheet_Activate() Dim TB As Worksheet Dim LRx As Integer, LR As Integer Dim Z1 As Integer, ZZ As Integer, i As Integer Dim JVon As Integer, JBis As Integer, Datum As Variant Z1 = 5 'Erste Zeile mit Daten JVon = InputBox("Von Jahr", , 2017) JBis = InputBox("Bis Jahr", , 2020) 'Reset LR = Me.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile des gesamten Blattes Me.Cells(Z1, 2).Resize(LR - Z1 + 1, 2).ClearContents ZZ = Z1 For Each TB In ThisWorkbook.Sheets If TB.Name Me.Name Then LRx = TB.Cells(TB.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte For i = Z1 To LRx Datum = TB.Cells(i, 3) If Not IsDate(Datum) And Datum "" Then MsgBox Datum & " : Datum-Fehler in Blatt " & TB.Name & " Nr. " & TB.Cells(i, 1) Else If Year(Datum) >= JVon And Year(Datum)

Beliebteste Forumthreads (12 Monate)

Mehrere Tabellenblätter in neues Kopiere

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere Tabellenblätter in neues Kopiere

14 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)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread