Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1864to1868
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
Kopieren und einfügen
27.01.2022 05:42:35
Frank
HAllo,
ich habe 6 Tabellenblätter.
hier mache ich eine Abfrage nach ein Datum, ob dieses in der entsprechenden Zeile drin steht.
wenn das Datum drin steht, dann möchte ich von der Zeile Spalte B und C kopieren und in ein neues Tabellenblatt einfügen.
und das ganze für alle 6 Tabellenblätter
Datum steht immer in Spalte D
Bsp.
Tabelle1
Datum gefunden in Zelle "D20"
Kopiert werden soll "B20:C20"
eingefügt in Tabelle9
kann man dabei jemand helfen?
danke schon einmal
Code bisher:

Sub auslesen2()
Dim Zeile, Spalte, Zletzte As Long
Dim Datum As Variant
Dim wks, wksActive As Variant
Dim x As String
Dim rng As Range
wksActive = ActiveSheet.Name
x = InputBox("Datum eingeben", "Datumsabfrage", Format(CDate(Now()), "dd.mm.yyyy"))
If IsNumeric(x) Then
Datum = Format(x, "DD.MM.")
ElseIf x = "" Then
Exit Sub
End If
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For wks = 1 To Worksheets.Count
Sheets(wks).Select
For Zeile = 2 To Cells(Rows.Count, 2).End(xlUp).Row
Set rng = ActiveSheet.Cells(Zeile, 4).Find(Datum)
If Not rng Is Nothing Then
' hier kopieren
End If
Next Zeile
If wks = 7 Then Exit For
Next wks
With Sheets(9)
.Select
'hier einfügen
If Not .PageSetup.PrintArea = "$A$1:$D$" & Zletzte Then
.PageSetup.PrintArea = "$A$1:$D$" & Zletzte
End If
.Range("G1").Value = Format(x, "DD.MM.YYYY")
End With
Sheets(wksActive).Select
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren und einfügen
27.01.2022 07:44:39
MCO
Moin, Frank!
Ich hab deinen Code mal angepasst, Kommentare im Code.

Sub auslesen2()
Dim Zeile, Spalte, Zletzte As Long
Dim Datum As Date
Dim wks As Worksheet, Ziel As Worksheet
Dim x As String
Set Ziel = Sheets(2)
x = InputBox("Datum eingeben", "Datumsabfrage", Format(CDate(Now()), "dd.mm.yyyy"))
If IsNumeric(x) Then
Datum = Format(x, "DD.MM.")
ElseIf x = "" Then
Exit Sub
End If
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For wks = 1 To Worksheets.Count - 1
With Sheets(wks)
'.Select 'Select kann fast immer entfallen
For Zeile = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
If .Cells(Zeile, 4) = Datum Then
.Range("B" & Zeile & ":C" & Zeile).Copy Ziel.Range("B" & Ziel.Cells(Rows.Count, "B").End(xlUp).Row + 1) ' hier kopieren + einfügen
End If
Next Zeile
End With
If wks = 7 Then Exit For 'warum nicht wks 1 to 7?
Next wks
With Sheets(9)
'.Select 'Select kann fast immer entfallen
.PageSetup.PrintArea = "$A$1:$D$" & Zletzte 'Nicht fragen, einfach setzen.
.Range("G1").Value = Format(x, "DD.MM.YYYY")
End With
'Sheets(wksActive).Select 'Brauchst du nicht, wir haben das sheet nie verlassen
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Viel Erfolg!
Gruß, MCO
Anzeige

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige