daten aus einem tabellenblatt in das andere kopier

Hallo Excel-Profis,
brauche dringend Eure Hilfe. Habe eine Excel-Datei (im Anhang), die Daten aus der Datei sollen mit dem Datum1, dem ausgang und dem eingang in das tabellenblatt 1 (namens datum1 kopiert werden) und das datum2 sollen dann entsprechend in das tabellenblatt datum2 kopiert werden. die palten können beliebig lang sein.
Danke von mal im voraus!!!
Artikelnummer Beschreibung Total Ausgang Total Eingang Datum 1 Ausgang Eingang Datum 2 Ausgang Eingang
1389 Kugelschreiber 1 200 200 23.08.2012 200 24.08.2012 200
1392 Kugelschreiber 2 50 23.08.2012 24.08.2012 50
1392 Kugelschreiber 3 100 100 23.08.2012 100 24.08.2012
1393 Kugelschreiber 4 50 50 23.08.2012 50 24.08.2012
1393 Kugelschreiber 5 400 23.08.2012 24.08.2012 400
1395 Kugelschreiber 6 150 150 23.08.2012 150 24.08.2012 150
1395 Kugelschreiber 7 100 23.08.2012 24.08.2012 100
1395 Kugelschreiber 8 650 650 23.08.2012 650 24.08.2012
1395 Kugelschreiber 9 60 23.08.2012 24.08.2012 60

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Frank,
hier mal die Einfachst-Lösung, für das Kopieren, wie ich es aus deiner Beschreibung herauslesen konnte.
Die Namen der Tabellenblätter und die jeweils zu kopierenden Spalten muss du im Code ggf. anpassen.
Gruß
Franz

Sub CopyData()
Dim wks_Q As Worksheet, wks_Z1 As Worksheet, wks_Z2 As Worksheet
Dim lngZeile As Long, StatusCalc As Long, rngCopy As Range
Set wks_Q = ActiveSheet
If MsgBox(Prompt:="Daten aus dem aktiven Tabellenblatt """ & wks_Q.Name _
& """ nach Blatt ""Datum 1"" und ""Datum 2"" kopieren?", _
Buttons:=vbQuestion + vbOKCancel, _
Title:="Artikeldaten kopieren") = vbCancel Then GoTo Beenden
Set wks_Z1 = ActiveWorkbook.Worksheets("Datum 1")
Set wks_Z2 = ActiveWorkbook.Worksheets("Datum 2")
'Makrobremsen lösen
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Altdaten ohne Zeile 1 in den Zielblättern löschen
With wks_Z1
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
If lngZeile > 1 Then .Range(.Rows(2), .Rows(lngZeile)).Delete
End With
With wks_Z2
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
If lngZeile > 1 Then .Range(.Rows(2), .Rows(lngZeile)).Delete
End With
With wks_Q
'letzte Zeile mit Daten in Spalte A (Artikelnummer) ermitteln
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten in Spalten A und B (Art-Nr, Bezeichnung) ab Zeile 2 in Datums-Tabellen kopieren
Set rngCopy = .Range(.Cells(2, 1), .Cells(lngZeile, 2))
rngCopy.Copy Destination:=wks_Z1.Cells(2, 1)
rngCopy.Copy Destination:=wks_Z2.Cells(2, 1)
'Daten in Spalten E bis F (Datum 1, Ausgang, Eingang) ab Zeile 2 in Datum1-Tabelle kopieren
Set rngCopy = .Range(.Cells(2, 5), .Cells(lngZeile, 7))
rngCopy.Copy Destination:=wks_Z1.Cells(2, 3)
'Daten in Spalten H bis J (Datum 2, Ausgang, Eingang) ab Zeile 2 in Datum2-Tabelle kopieren
Set rngCopy = .Range(.Cells(2, 8), .Cells(lngZeile, 10))
rngCopy.Copy Destination:=wks_Z2.Cells(2, 3)
End With
'Makrobremsen zurücksetzen
With Application
.Calculation = StatusCalc
.ScreenUpdating = True
.EnableEvents = True
End With
Beenden:
'Variablen aufräumen
Set wks_Q = Nothing: Set wks_Z1 = Nothing: Set wks_Z2 = Nothing: Set rngCopy = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

daten aus einem tabellenblatt in das andere kopier

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

323 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

daten aus einem tabellenblatt in das andere kopier

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

323 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread