AW: Daten fortlaufend kopieren in Tabelle1
25.07.2006 14:45:25
fcs
Hallo Nick,
eigentlich ist der Vorlagenassistent mit Anbindung einer Vorlagedatei an eine Datenbank schon ein guter Weg. Voraussetzungen:
1. Vorlagedatei wird allen Benutzern zur Verfügung gestellt (kein Problem!)
2. Auf die Datenbank-Datei (Excelmappe oder sonstige Datenbankdatei) kann von allen Benutzer-PCs aus in einem Netzwerk zugegriffen werden.
Dadurch werden die Eingaben aller Benutzer zentral in einer Datei gesammelt. Der Benutzer kann -muss aber nicht- seine Eingaben jeweils als Einzeldatei speichern.
Wenn der Benutzer seine Formblattdatei speichert oder schließt wird er gefragt, wie die
Daten in der Datenbank gespeichert werden sollen (vorhandenen Datensatz ändern, neuen Datensatz anlegen oder nichts speichern. Der Speichern-Button ist dann der Button, den du gerne hättest.
Nachfolgend ein Makro-Beispiel zur Übertragung der Daten aus Tabelle 1 nach Tabelle 2.
gruss Franz
Sub EingabeDaten_nach_Tabelle2()
Dim wks1 As Worksheet, wks2 As Worksheet, lngZeile As Long
Set wks1 = ActiveWorkbook.Sheets("Tabelle1")
Set wks2 = ActiveWorkbook.Sheets("Tabelle2")
' Prüfung Vollständigkeit der Eingaben
If IsEmpty(wks1.Range("G3")) Then MsgBox "Datum ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("B6")) Then MsgBox "Firma ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("C8")) Then MsgBox "Ort ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("C10")) Then MsgBox "Ansprechpartner ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("C12")) Then MsgBox "V-Ort ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("E12")) Then MsgBox "E-Ort ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("H12")) Then MsgBox "LKZ ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("C14")) Then MsgBox "Sendungsdaten sind nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("B16")) Then MsgBox "Vorlauf ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("D16")) Then MsgBox "SLVS ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("F16")) Then MsgBox "E+V ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("H16")) Then MsgBox "HL ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("B19")) Then MsgBox "NL ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("D19")) Then MsgBox "Gesamt ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("F19")) Then MsgBox "VK ist nicht eingegeben": Exit Sub
If IsEmpty(wks1.Range("B4")) Then MsgBox "Bearbeiter ist nicht eingegeben": Exit Sub
'Nächste freie Zeile in Tabelle2
lngZeile = wks2.Cells(wks2.Rows.Count, 1).End(xlUp).Row + 1
' Daten übertragen
wks2.Cells(lngZeile, 1).Value = wks1.Range("G3").Value 'Datum
wks2.Cells(lngZeile, 2).Value = wks1.Range("B6").Value 'Firma
wks2.Cells(lngZeile, 3).Value = wks1.Range("C8").Value 'Ort
wks2.Cells(lngZeile, 4).Value = wks1.Range("C10").Value 'Ansprechpartner
wks2.Cells(lngZeile, 5).Value = wks1.Range("C12").Value 'V-Ort
wks2.Cells(lngZeile, 6).Value = wks1.Range("E12").Value 'E-Ort
wks2.Cells(lngZeile, 7).Value = wks1.Range("H12").Value 'LKZ
wks2.Cells(lngZeile, 8).Value = wks1.Range("C14").Value 'Sendungsdaten
wks2.Cells(lngZeile, 9).Value = wks1.Range("B16").Value 'Vorlauf
wks2.Cells(lngZeile, 10).Value = wks1.Range("D16").Value 'SLVS
wks2.Cells(lngZeile, 11).Value = wks1.Range("F16").Value 'E+V
wks2.Cells(lngZeile, 12).Value = wks1.Range("H16").Value 'HL
wks2.Cells(lngZeile, 13).Value = wks1.Range("B19").Value 'NL
wks2.Cells(lngZeile, 14).Value = wks1.Range("D19").Value 'Gesamt
wks2.Cells(lngZeile, 15).Value = wks1.Range("F19").Value 'VK
wks2.Cells(lngZeile, 16).Value = wks1.Range("H19").Value 'BGM
wks2.Cells(lngZeile, 17).Value = wks1.Range("B4").Value 'Bearbeiter
'Datei speichern
ActiveWorkbook.Save
'einige Eingabefelder leeren für nächste Eingabe
wks1.Range("B6").ClearContents 'Firma
wks1.Range("C8").ClearContents 'Ort
wks1.Range("C10").ClearContents 'Ansprechpartner
wks1.Range("C12").ClearContents 'V-Ort
wks1.Range("E12").ClearContents 'E-Ort
wks1.Range("C14").ClearContents 'Sendungsdaten
MsgBox "Daten wurden nach Tabelle 2 übertragen."
End Sub