Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
816to820
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
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro trotz "DragAndDrop = False"

Makro trotz "DragAndDrop = False"
10.11.2006 20:16:25
Peter
Hallo Excelfreunde
ich habe ein kleines Problem mit dem Copieren von Daten von einer in die andere Datei.
Die Tabellen habe ich mit Code gegen copieren/ausschneiden geschützt.
procKopierenAusschneidenAus
Application.CellDragAndDrop = False
Ich möchte mir ein Makro basteln mit dem ich alle Daten aus Datei A in die Datei B copieren kann.
Die beiden Dateien haben jeweils 8 Tabellenblätter mit Werten.
Sie sind also identisch bis auf den Dateinamen.
Mir würde es schon reichen, wenn ich in Datei A das Makro ausführe. (alle Daten werden kopiert)
Wenn ich in Datei B bin, kann zB ein zweites Makro die Werte einfügen. (alle daten einfügen)
Wer kann oder will mir hierbei behilflich sein.
Gruß Dieter

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro trotz "DragAndDrop = False"
11.11.2006 07:28:51
fcs
Hallo Dieter,
hier zwei Codes, die die Werte bzw. Formate+Werte übertragen.
Das Makro muss du in der Original-Datei einbauen.
Die Einstellung für CellDragAndDrop spielt dabei keine Rolle. Diese wirkt sich nur auf die mit der Maus möglichen Aktionen aus.
Gruss
Franz

Sub AlleDatenKopieren()
'Formate und Werte kopieren
Dim wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Set wbQuelle = Workbooks("DateiOriginal.xls")
Set wbZiel = Workbooks("DatenKopie.xls")
'oder Set wbQuelle = Workbooks.Open("C:\Test\Daten\DatenKopie.xls")
Application.ScreenUpdating = False
For Each wksQuelle In wbQuelle.Worksheets
Set wksZiel = wbZiel.Worksheets(wksQuelle.Name)
wksZiel.UsedRange.Clear
wksQuelle.UsedRange.Copy
wksZiel.Range(wksQuelle.UsedRange.Address).PasteSpecial xlPasteFormats
wksZiel.Range(wksQuelle.UsedRange.Address).PasteSpecial xlValues
Next wksQuelle
Application.ScreenUpdating = True
wbZiel.Save
'wbZiel.Close
End Sub
Sub AlleDatenKopieren2()
'Nur Werte in Kopie übertragen
Dim wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Set wbQuelle = Workbooks("DateiOriginal.xls")
Set wbZiel = Workbooks("DatenKopie.xls")
'oder Set wbQuelle = Workbooks.Open("C:\Test\Daten\DatenKopie.xls")
For Each wksQuelle In wbQuelle.Worksheets
Set wksZiel = wbZiel.Worksheets(wksQuelle.Name)
wksZiel.UsedRange.ClearContents
wksZiel.Range(wksQuelle.UsedRange.Address).Value = wksQuelle.UsedRange.Value
Next wksQuelle
wbZiel.Save
'wbZiel.Close
End Sub

Anzeige
AW: Makro trotz "DragAndDrop = False"
11.11.2006 17:42:20
Peter
Hallo Franz
danke erst einmal für deine Hilfe.
Ich währe ja nicht ich, wenn ich auf Anhieb damit klarkommen würde.
Die Dateinamen sind nicht fix.
Ist es möglich 1 Makro (Kopieren) in der gerade aktiven Datei zu starten und nach anwahl der 2ten Datei das 2te Makro (Einfügen) anzuwählen(auszuführen)
Dein 2tes Makro benötige ich (Nur Werte kopieren)
Ich habe versucht auch ohne Blattschutz das Makro auszuführen, aber es wird gemeldet "Laufzeitfehler 1004 ....Die Zelle oder das Diagramm ist geschützt"
Kannst du mir weiterhelfen?
Ich kann auch mal die Datei hochladen.
In ihr kann ich die werte mittels Makro löschen.
Nur mir fehlt noch ein Makro zum kopieren.
Gruß Dieter
Anzeige
AW: Makro trotz "DragAndDrop = False"
11.11.2006 20:40:32
fcs
Hallo Dieter,
ich sehe 2 sinnvolle Möglichkeiten:
1.) Du baust das Makro in jede Original-Datei ein.
Damit ist die Quelldatei fest, die Kopiedatei wird per Datei-Auswahl-Dialog ausgewählt
2.) Du speicherst das Makro in einer separaten Excel-Datei, von der aus du den Kopiervorgang vorbereitest (Original-Datei auswählen (Datei-Auswahl-Dialog oder Drop-Down-Auswahl-Liste), Kopie-Datei (Datei-Auswahl-Dialog) wählen

Die Dateinamen sind nicht fix.

Das kann man wie oben beschrieben per Auswahlliste lösen oder Datei-Auswahl-Dialog.

Ist es möglich 1 Makro (Kopieren) in der gerade aktiven Datei zu starten und nach anwahl der 2ten Datei das 2te Makro (Einfügen) anzuwählen(auszuführen)

Hab es probiert, geht irgendwie nicht. Mit dem Start des 2. Makros geht die Info über den kopierten Zellbereich in der Originaldatei verloren.
Macht aber für dich auch keinen Sinn, denn da hättest du jede Menge Handarbeit die nicht unbedingt nötig ist. Alles mit einem Makro in der Originaldatei zu machen oder einer Steuerungsdatei ist der bessere Weg.

Ich habe versucht auch ohne Blattschutz das Makro auszuführen, aber es wird gemeldet "Laufzeitfehler 1004 ....Die Zelle oder das Diagramm ist geschützt"

Der Blattschutz muss für jedes Tabellenblatt in der Kopie-Datei vor dem Löschen/Einfügen der Daten aufgehoben und danach wieder aktiviert werden, geht per Makro. Falls du auch noch mit Passwort arbeitest, dann kann man das auch einbauen.

Kannst du mir weiterhelfen?

siehe oben :D

Ich kann auch mal die Datei hochladen.

Noch nicht unbedingt nötig
Ich hab das Kopiermakro mal etwas angepasst. Das Makro muss du in ein Modul der Original-Datei einfügen.
Evtl. ist ja auch die etwas einfachere Variante etwas für dich. Diese speichert unter dem gewählten Dateinamen eine Kopie der aktiven Arbeitsmappe.
Gruss
Franz

Sub AlleDatenKopieren2()
'Nur Werte in Kopie übertragen
Dim wbQuelle As Workbook, wbZiel As Workbook, Schutz As Boolean, Pfad As String
Dim wksQuelle As Worksheet, wksZiel As Worksheet, DateiKopie As Variant
Set wbQuelle = ThisWorkbook 'Diese Datei = Originaldatei
Pfad = ActiveWorkbook.Path
ChDir ("C:\Test") 'Startverzeichnis für nachfolgende Dateiauswahl ANPASSEN!!
DateiKopie = Application.GetOpenFilename(Filefilter:="Exceldatei(*.xls),*.xls", _
Title:="Bitte Kopie-Datei auswählen")
If DateiKopie = False Then Exit Sub 'Abbrechen geklickt
Set wbZiel = Workbooks.Open(DateiKopie)
For Each wksQuelle In wbQuelle.Worksheets
Set wksZiel = wbZiel.Worksheets(wksQuelle.Name)
If wksZiel.ProtectContents = True Then
wksZiel.Unprotect ' oder .Unprotect Password:="XYZ"
Schutz = True
Else
Schutz = False
End If
wksZiel.UsedRange.ClearContents
wksZiel.Range(wksQuelle.UsedRange.Address).Value = wksQuelle.UsedRange.Value
If Schutz = True Then wksZiel.Protect ' oder .Protect Password:="XYZ"
Next wksQuelle
wbZiel.Save
ChDir (Pfad)
'wbZiel.Close
End Sub
Sub DateiKopie()
'Kopie der Datei speichern
Dim Pfad As String, DateiKopie As Variant
Pfad = ActiveWorkbook.Path
ChDir ("C:\Test") 'Startverzeichnis für nachfolgende Dateiauswahl ANPASSEN!!
DateiKopie = Application.GetOpenFilename(Filefilter:="Exceldatei(*.xls),*.xls", _
Title:="Bitte Kopie-Datei auswählen")
If DateiKopie = False Then Exit Sub 'Abbrechen geklickt
ActiveWorkbook.SaveCopyAs FileName:=DateiKopie
ChDir (Pfad)
End Sub

Anzeige
AW: Makro trotz "DragAndDrop = False"
11.11.2006 21:42:02
Peter
Hallo Franz
das Makro funktioniert gut mit dem letzten Code.
Zieldatei auswählen ist auch eine gute Lösung.
Ich werde den Code in alle Dateien einfügen.
Das Makro packe ich mir in "Mein Menu"
Was aber jetzt nicht mehr funktioniert sind die anderen Makros die das Datum in den Diagrammen ändert.
Es werden auch noch die alten Werte in den Diagrammen angezeigt.
Gruß Dieter
AW: Makro trotz "DragAndDrop = False"
11.11.2006 22:04:53
Peter
Hallo Franz
ich habe den Fehler gefunden.
Es werden alle Werte (Daten) übertragen auch in die Diagramme.
Also die Formeln sind dann auch weg.
Ich habe einen Fehler gemacht und nicht gesagt das nur die Eingabetabellen geändert(kopiert) werden sollen.
Diese Tabellen werden alle Eingabe..... genannt.
Die Eingabefelder fangen alle mit B12 bis GE 73 an.
Kannst du hier noch mal schauen was zu tuen ist.
Gruß Dieter der glücklicher Weise noch eine Kopie der dateien hat
Anzeige
AW: Makro trotz "DragAndDrop = False"
12.11.2006 00:03:14
fcs
Hallo Dieter,
wohl dem der eine Sicherungskopie hat. Ist bei solchen Versuchen mit VBA-Makros auch unbedingt erforderlich.
Am besten immer Makros einbauen, Datei speichern, Makro ablaufen lassen und prüfen ob das Ergebnis stimmt, wenn NEIN dann Datei ohne speichern schließen und nach dem Öffen Makro korrigieren oder wegschmeissen.
Ich hab nicht nur geschaut was zu tun ist, ich hab es auch noch gleich gemacht :-)
Hier die neue Version, die nur noch die Werte aus dem Bereich "B12:GE73" überträgt, wenn der Blattname mit "Eingabe" beginnt.
Gruss
Franz

Sub AlleDatenKopieren2()
'Nur Werte in Kopie übertragen
Dim wbQuelle As Workbook, wbZiel As Workbook, Schutz As Boolean, Pfad As String
Dim wksQuelle As Worksheet, wksZiel As Worksheet, DateiKopie As Variant
Set wbQuelle = ThisWorkbook 'Diese Datei = Originaldatei
Pfad = ActiveWorkbook.Path
ChDir ("C:\Test") 'Startverzeichnis für nachfolgende Dateiauswahl ANPASSEN!!
DateiKopie = Application.GetOpenFilename(Filefilter:="Exceldatei(*.xls),*.xls", _
Title:="Bitte Kopie-Datei auswählen")
If DateiKopie = False Then Exit Sub 'Abbrechen geklickt
Set wbZiel = Workbooks.Open(DateiKopie)
For Each wksQuelle In wbQuelle.Worksheets
If Left(wksQuelle.Name, 7) = "Eingabe" Then
Set wksZiel = wbZiel.Worksheets(wksQuelle.Name)
If wksZiel.ProtectContents = True Then
wksZiel.Unprotect ' oder .Unprotect Password:="XYZ"
Schutz = True
Else
Schutz = False
End If
wksZiel.Range("B12:GE73").ClearContents
wksZiel.Range("B12:GE73").Value = wksQuelle.Range("B12:GE73").Value
If Schutz = True Then wksZiel.Protect ' oder .Protect Password:="XYZ"
End If
Next wksQuelle
wbZiel.Save
ChDir (Pfad)
'wbZiel.Close
End Sub

Anzeige
@ fcs
12.11.2006 09:50:42
Peter
Hallo Franz
ich danke dir deine Hilfe und für den Code.
Es funktioniert alles so wie es sein sollte.
Gruß Dieter

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige