AW: Gefüllte Zeilen in andere Mappe kopieren
02.08.2019 10:03:43
fcs
halo icks1,
du solltest dir etwas mehr Zeit nehmen, die Makros, die dir hier erstellt werden auch zu verinnerlichen. Dann würde dir auch langsam klar werden, wie man üer VBA systematisch Daten zwischen 2 oder mehreren Tabellenblättern transferieren kann.
Du musst ja "nur" deine Aufgabenliste in die logisch richtige Reihenfolge bringen und dann die passendne en VBA-Anweisungen suchen/parametrieren, um die gewünschte Funktionalität umzusetzen.
Rom wurde ja auch nicht an einem Tag erbaut. Aber man muss halt anfangen zu bauen, damit am Ende etwas steht - genauso ist es mit VBA.
LG
Franz
Sub Copy_to_ZW_database()
If MsgBox("Daten nach Datei ""ZW_datbase.xlsx"" kopieren?", vbQuestion + vbOKCancel, _
"Daten in Datenbank sichern") = vbCancel Then Exit Sub
Dim wksQuelle As Worksheet
Dim Zei_F As Long, Zei_FL As Long
Dim strNameDB As String, wkbZiel As Workbook, wksZiel As Worksheet
Dim Zei_D As Long
Set wksQuelle = ActiveWorkbook.Worksheets("Database_train")
With wksQuelle
'letzte Zeile mit Inhalt in Blatt Database_train
Zei_FL = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlPrevious).Row
End With
'Pfad\Name der Datenbank-Datei - ggggf. Verzeichnis anpassen!!!
strNameDB = ThisWorkbook.Path & Application.PathSeparator & "ZW_database.xlsx"
If Dir(strNameDB) = "" Then
MsgBox "Datei """ & strNameDB & """ nicht gefunden!"
Exit Sub
End If
Application.ScreenUpdating = False
Set wkbZiel = Application.Workbooks.Open(Filename:=strNameDB)
Set wksZiel = wkbZiel.Worksheets("database_train")
With wksZiel
'letzte Zeile mit Inhalt in Datenbank
Zei_D = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlPrevious).Row
End With
With wksQuelle
'letzte Zeile mit Inhalt in Quelltabelle
Zei_FL = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlPrevious).Row
For Zei_F = 2 To Zei_FL
If .Cells(Zei_F, 1).Text "" Then
Zei_D = Zei_D + 1
.Rows(Zei_F).Copy wksZiel.Rows(Zei_D)
.Cells(Zei_F, 7).Value = "C" 'kopierte Zeile Markieren in Spalte G
End If
Next
End With
wkbZiel.Close savechanges:=True
Application.ScreenUpdating = True
End Sub