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

Daten automatisch verschieben

Daten automatisch verschieben
20.12.2007 12:49:00
Nico
Hallo zusammen,
ich habe ein Problem, welches dem ähnelt, was hier eben schon mal beschrieben wurde, allerdings bin ich in VBA eine komplette Niete und verstehe daher nicht so ganz, was da geschrieben wurde.
Ich habe eine Eingabetabelle mit sechs Spalten und beliebig vielen Zeilen (beginnend bei 4).
Hier gebe ich Daten ein und möchte dann, wenn alles drin ist (manchmal 1 Zeile, manchmal 2, manchmal 10) ein Makro anwenden, welches alle Daten in eine andere Datei packt und zwar ab der ersten leeren Zeile.
Der Spaltenaufbau der zweiten Datei entspricht natürlich dem der ersten und die zweite Datei wird immer größer...
Hat da jemand eine Lösung, um mir Weihnachten zu versüßen ?
Vielen Dank im Voraus und allen ein Frohes Fest und einen Guten Rutsch
Nico

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten automatisch verschieben
20.12.2007 14:54:18
fcs
Hallo Nico,
hier ein Beispiel-Code. Die Tabellennamen und Datei- und Pfadbezeichnungen muss du noch anpassen.
Das Makro muss du in ein Modul in der Datei mit der Eingabetabelle kopieren.
Vorweihnachtliceh Grüße
Franz

Sub EingabenKopieren()
'Daten aus Blatt Eingabe in Zieltabelle kopieren
If MsgBox("Eingabedaten in Zieldatei kopieren?", vbYesNo, _
"Daten in Zieltabelle übertragen") = vbNo Then Exit Sub
Dim wbEingabe As Workbook, wksEingabe As Worksheet, ZeileEL As Long
Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZL As Long
Const ZeileE1 As Long = 4 'Erste Eingabezeile
Const Spalte1 As Integer = 1 '1. Spalte
Const SpalteL As Integer = 6 'Letzte Spalte
Const Zieldatei As String = "TestDatei.xls"
Const PfadZieldatei As String = "C:\Lokale Daten\Test"
Set wbEingabe = ThisWorkbook
Set wksEingabe = wbEingabe.Worksheets("Eingabe")
'Prüfen ob Zieldatei geöffnet
For Each wbZiel In Workbooks
If LCase(wbZiel.Name) = LCase(Zieldatei) Then
Exit For
End If
Next
If wbZiel Is Nothing Then
Set wbZiel = Workbooks.Open(Filename:=PfadZieldatei & "\" & Zieldatei)
End If
Set wksZiel = wbZiel.Worksheets("Daten")
With wksEingabe
'Letzte Eingabezeile ermitteln
ZeileEL = ZeileE1 - 1
For Spalte = Spalte1 To SpalteL
If ZeileEL = ZeileE1 Then
With wksZiel
'Nächste Leere Zeile ermitteln
ZeileZL = 1
For Spalte = Spalte1 To SpalteL
If ZeileZL 


Anzeige
AW: Daten automatisch verschieben
20.12.2007 19:10:10
Nico
Hallo Franz,
vielen Dank für Deine Mühen, allerdings habe ich noch Probleme, welche Teile des Codes ich anpassen muss. Ich habe im oberen Bereich die entsprechenden Dateinamen und Pfade eingegeben.
Wenn ich das Makoro jetzt ausführen will, bleibt er weiter unten bei "Spalte" hängen.
Ich hänge mal die beiden Dateien an. Dann wird vielleicht klarer, was ich machen möchte. Vielleicht kannst Du auch so lieb sein und die Stellen markieren, an denen ich was ändern/anpassen muss.
Hier die Links:
Eingabe:

Die Datei https://www.herber.de/bbs/user/48566.xls wurde aus Datenschutzgründen gelöscht


Zieldatei:
https://www.herber.de/bbs/user/48567.xls
Danke und Gruß
Nico

Anzeige
AW: Daten automatisch verschieben
20.12.2007 20:02:00
fcs
Hallo Nico,
das Problem mit "spalte" war, dass ich vergessen hatte die Variable zu deklarieren. Da du in der Datei mit "Option Explicit" als Einstellung arbeitest kam diese Fehlermeldung.
Ich hab deine Eingabe Datei entsprechend angepasst. Das Makro startet jetzt per Klick auf den Button. Die ggf. anzupassenden Zeilen hab ich markiert.
Gruß
Franz
https://www.herber.de/bbs/user/48570.xls

AW: Daten automatisch verschieben
21.12.2007 10:04:00
Nico
Hallo Franz,
irgendwie bin ich echt zu doof und hoffe, daß ich DIr nicht auf die Nervern gehe, aber jetzt hängt er sich hier auf:
Set wksEingabe = wbEingabe.Worksheets("Bestellwesen_Eingabe") '###Anpassen
Ich habe den Dateinamen der Eingabe-Datei eingegeben, aber er bleibt an der Stelle stehen.
Gruß
Nico

Anzeige
AW: Daten automatisch verschieben
21.12.2007 11:06:00
fcs
Hallo Nico,
in dieser Zeile wird das Tabellemblatt für die Eingabe festgelegt.
In der Zeile davor
Set wbEingabe = ThisWorkbook
wird die Datei mit der Eingabetabelle festgelegt. "Thisworkbook" ist dabei immer die Datei in der eine Prozedur gespeichert ist.
In Zeile
Set wksEingabe = wbEingabe.Worksheets("Tabelle1") '###Anpassen
muss du den Namen des Tabellenblatts -nicht den der Datei!!- angeben in dem die Eingaben gemacht werden.
Alternativ geht es auch mit der Zählnummer des Registerblattes. Da du nur ein Blatt in der Arbeitsmappe hast gibt es da auch keine Probleme
Set wksEingabe = wbEingabe.Worksheets(1)
Gruß
Franz

Anzeige
AW: Daten automatisch verschieben
21.12.2007 13:25:00
Nico
Vielen lieben Dank,
funktioniert super !
1. Jetzt öffnet sich bei der Übertragung der Daten ja die Zieldatei. Geht das ohne ? So daß die Daten sich da reinschreiben und der "Eingebende" sieht die Zieldatei gar nicht erst ? Es werden nämlich verschiedene Personen Daten zu der Zieldatei hinzufügen, die aber eigentlich die gesamte Liste nicht unbedingt sehen sollen...
2. Kann ich Dir irgendwas Gutes tun ? Du hast mir echt sehr geholfen... nicoroden at mmc punkt com
Schreib mich mal per E-Mail an und ich sage Dir, was ich an Ideen hätte...
Danke und Gruß
Nico

Anzeige
AW: Daten automatisch verschieben
21.12.2007 15:23:00
Nico
Hallo Franz,
mit ein bißchen Logik habe ich das mit dem Schließen schon selbst hinbekommen.
Was passiert denn, wenn ein anderer User in der Zieldatei arbeitet, während jemand anders Daten übermittelt ?
Gruß
Nico

AW: Daten automatisch verschieben
21.12.2007 15:50:41
fcs
Hallo Nico,
wenn ein anderer User die Datei geöffnet hat, dann wird die Datei schreibgeschützt geöffnet und soweit ich weiss wird zusätzlich eine Meldung angezeigt.
Mann kann dann nicht in die Originaldatei speichern.
Ich hab im Moment nicht den Code parat, mit dem man den Zustand prüfen und nach einer Meldung den Schreibvorgang abbrechen kann.
Damit der Anwender vom öffnen/schließen der Zieldatei nur wenig mitbekommt kann man noch die Befehle
Application.ScreenUpdating = False
am Beginn und
Application.ScreenUpdating = True
gegen Ende des Codes einbauen.
Gruß
Franz

Anzeige
AW: Daten automatisch verschieben
21.12.2007 19:03:00
fcs
Hallo Nico,
ich hab die Prozedur um Zeilen ergänzt, die Prüfen,ob die Datei schreibgeschützt geöffnet wurde.
Die Bildschirmaktualiserung hab ich während der Makroausführung deaktiviert.
Das Schließen der Master-Datei nach dem Speichern hab ich auch nochmals eingefügt. Die eingefügten Zeilen sind jeweils markiert.
Gruß
Franz

Sub EingabenKopieren()
'Daten aus Blatt Eingabe in Zieltabelle kopieren
If MsgBox("Eingabedaten in Zieldatei kopieren?", vbYesNo, _
"Daten in Zieltabelle übertragen") = vbNo Then Exit Sub
Dim wbEingabe As Workbook, wksEingabe As Worksheet, ZeileEL As Long
Dim wbZiel As Workbook, wksZiel As Worksheet, ZeileZL As Long
Dim Spalte As Integer
Const ZeileE1 As Long = 4 'Erste Eingabezeile
Const Spalte1 As Integer = 1 '1. Spalte
Const SpalteL As Integer = 6 'Letzte Spalte '
Const Zieldatei As String = "Bestellwesen_Master.xls" '###Anpassen
Const PfadZieldatei As String = "D:\Daten\Nico\MMC\Bestellwesen" '###Anpassen
Set wbEingabe = ThisWorkbook
Set wksEingabe = wbEingabe.Worksheets("Tabelle1") '###Anpassen
'###Neu1
Application.ScreenUpdating = False
'###Neu1 Ende
'Prüfen ob Zieldatei geöffnet
For Each wbZiel In Workbooks
If LCase(wbZiel.Name) = LCase(Zieldatei) Then
Exit For
End If
Next
If wbZiel Is Nothing Then
Set wbZiel = Workbooks.Open(Filename:=PfadZieldatei & "\" & Zieldatei)
End If
'###Neu2
If wbZiel.ReadOnly = True Then
MsgBox "Die Zieldatei ist zur Zeit schreibgeschützt!" & vbLf & vbLf _
& "Bitte Speichern später wiederholen!"
wbZiel.Close savechanges:=False
Else
'###Neu2 Ende
Set wksZiel = wbZiel.Worksheets("Tabelle1") '###Anpassen
With wksEingabe
'Letzte Eingabezeile ermitteln
ZeileEL = ZeileE1 - 1
For Spalte = Spalte1 To SpalteL
If ZeileEL = ZeileE1 Then
With wksZiel
'Nächste Leere Zeile ermitteln
ZeileZL = 1
For Spalte = Spalte1 To SpalteL
If ZeileZL 


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige