Makro - Kopieren eines Datenbereiches

Hallo liebe Excel Profis :)
Ich hoffe, dass ich bei euch auf eine Lösung meines Problemes stoße. Zwar konnte ich Einzelteile des Problemes mittels eures Forums lösen, jedoch nicht Gänze.
Zum Problem:
Es gibt zwei Exceldateien, welche beide geöffnet sind.
Die erste Datei, Quelle.xlsm, beinhaltet die Quelldaten, welche in die zweite Datei, Auswertung.xlsm, kopiert werden sollen. Die Quelledaten beinhalten Informationen einer Kalenderwoche zu verschiedenen Abteilungen. Diese Informationen stehen in einem Arbeitsblatt "Liste" nebeneinander. Jedoch müssen diese Quelldaten in mehrere Tabellenblätter der Auswertung.xlms kopiert werden. In Spalte der Spalte B stehen die Daten zur Abteilung 1, welche in das Tabellenblatt "Abteilung 1" kopiert werden muss. In der Spalte C die Daten der Abteilung 2, welche in das Tabellenblatt "Abteilung 2" kopiert werden muss, usw.
Da die Datei Auswertung.xlsm jede Woche mit Werten gefüllt wird, stehen dort in den den Tabellenblättern der jweiligen Abteilung viele Kalenderwoche neben einander. Der Anwender soll daher durch das Tabellenblatt "Datum" die Möglichkeit haben, die KW einzugeben, in der die Daten eingefügt werden sollen.
Damit möglichst dynamisch programmiert werden kann, habe ich in der Auswertung.xlsm ein Tabellenblatt "Admin" erstellt. Hier habe ich mittels Excelformeln definiert, wo die Quelldatei gespeichert ist, wie diese heißt, welcher Bereich kopiert werden soll und in welche KW eingefügt werden soll. Somit wird sicher gestellt, dass wenn sich der Name der Quelldatei ändert, ein Datenkriterium hinzugefügt wird o.Ä. die Datei trotzdem noch funktionsfähig ist. Ich glaube, ich habe eigentlich alles so weit vorbereitet und definiert, dass mittels Variablen in VBA ein Makro geschrieben werden könnte, dass diesen Kopiervorgang durchführt.
Und jetzt kommt ihr ins Spiel :) Ich habe nur rudimentäre Grundkenntnisse in VBA, wenngleich ich behaupten würde, dass ich Excel sehr gut beherrsche. Könntet ihr mir bitte dabei helfen, mein oben geschildertes Problem zu lösen? Ich habe natürlich die beiden Dateien als Beispiel angehängt, sodass anhand der Dateien hoffentlich deutlicher wird, inwiefern ich eure Hilfe brauche :)
https://www.herber.de/bbs/user/107170.xlsm
https://www.herber.de/bbs/user/107172.xlsm
Vielen Dank im Voraus für eure Hilfe!
Viele Grüße. Flo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit '24..3.2016 Piet Const Quelle = "107170.xlsm" 'Name der Quelldatei 'Ziel = ThisWorkbook Dim ShQ As Object, ShZ As Object Dim Adm As Object, AC As Object Dim Adr As String, Edr As String Dim WbQ As Object, KWC As String Sub kopieren() Dim x As Integer, y As Integer 'von Zeile/ Spalte Dim s As Integer, t As Integer 'bis Z/S Dim z As Integer, u As Integer 'Ziel Z/S Set WbZ = ThisWorkbook Set WbQ = Workbooks(Quelle) Set ShQ = WbQ.Worksheets("Liste") Set Adm = WbZ.Worksheets("Admin") 'Schleişfe für alle Abteilungen For Each AC In Adm.Range("B10:F10") With WbZ.Worksheets(AC.Value) KWC = AC.Offset(14, 0) 'KW-KWC 'Zahlen Werte laden: von/bis x = AC.Offset(1, 0): s = AC.Offset(3, 0) y = AC.Offset(2, 0): t = AC.Offset(4, 0) z = AC.Offset(15, 0): u = AC.Offset(16, 0) If KWC = Empty Then MsgBox "KW KWC fehlt": GoTo weiter If x = 0 Or s = 0 Then MsgBox "Quell von fehlt": GoTo weiter If y = 0 Or t = 0 Then MsgBox "Quell bis fehlt": GoTo weiter If z = 0 Or u = 0 Then MsgBox "Ziel von/bis fehlt": GoTo weiter 'vor Kopieren KW Code prüfen If .Cells(3, u) KWC Then MsgBox .Name & " - KW KWC stimmt nicht überein" ElseIf .Cells(3, u) = KWC Then Adr = Cells(x, s).Address 'Quelle Adresse Edr = Cells(y, t).Address 'Kopieren und in Ziel Abteilung einfügen ShQ.Range(Adr, Edr).Copy .Cells(z, u).PasteSpecial xlPasteValues End If weiter: End With Next AC Application.CutCopyMode = False End Sub

Hallo Piet,
erst einmal vielen Dank, dass du dich mit dieser sehr umfangreichen Problemstellung auseinander gesetzt hast. Damit hast du mir sehr geholfen, danke!
Da das Makro noch nicht ganz, aber durchaus in Ansätzen funktioniert hat, ein paar Fragen bzw. Anmerkungen:
1) Bekomme den Fehler, dass Wbz nicht deklariert sei. Habe ich eigenständig nachgeholt mit

Dim Wbz As Workbook

Das passt so oder?
2)Komischerweise kopiert dein Makro wunderbar die Daten der Abteilung 1 in das zugehörige Arbeitsblatt. Für alle weiteren Abteilungen bekomme ich die Fehlermeldung KW KWC fehlt. Obwohl die erste Abteilung in die richtige KW kopiert wurde
Ich würde mich sehr freuen, wenn du mir nochmal dabei helfen könntest, dein Makro voll funktionsfähig werden zu lassen. Vielen Dank!
Gruß.
Flo

Beliebteste Forumthreads (12 Monate)

Makro - Kopieren eines Datenbereiches

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread