Zeilen von Mappe1 in Mappe2 anfügen

Hallo,
ich möchte Datensätze aus Mappe1 (im Pfad1) in eine Mappe2, (Pfad2) übertragen bzw. anhängen und dann Mappe1 unter einem bestimmten Dateinamen abspeichern.
In Mappe1, Tabelle1 ist ein Formular aufgebaut und geöffnet. Aus diesen Zellinhalten erzeuge ich in Tabelle3 einen einzeiligen Satz und in Tabelle4 ein zweizeiligen Satz (plus jeweils Überschriften in Zeile1). Ich möchte nun mit einem commandbutton erreichen, dass zunächst drei Variableninhalte fixiert werden: username, Date (TT.MM.JJJJ) und Time (hh.mm.ss) und diese drei Inhalte dann in B2,C2,D2 (bei Tabelle3) bzw. beim zweizeiligen Satz in B2, C2,D2 und B3,C3,D3 (Tabelle4) vorher ergänzt werden. Der eine Satz bzw. die beiden Sätze sollen nun nach Mappe2 übertragen werden. Mappe2 wird geöffnet, die Zeile 2 (aus Mappe1, Tabelle3) kopiert und mit ihren Werten nach Mappe2, Pfad2, Tabelle1 (einzeilig) in die nächste freie Zeile übertragen. Gleiches dann für die beiden Zeilen (Zeile 2 und 3) aus Tabelle4. Auch diese beiden Sätze sollen nach Mappe2, jetzt nach Tabelle2 (mit ihren Werten) übertragen werden (auch in die nächste freie Zeile).
Mappe2 wird unter gleichem Namen wieder gespeichert und geschlossen. Mappe1 hingegen soll im Pfad1 unter dem Dateinamen (Wert) abgespeichert werden, der in Tabelle1, Zelle A50 steht.
Wer könnte mir zu diesem theoretischen Ansatz etwas praktische Unterstützung geben?
Vielen Dank im Voraus.
Grüße, Constantin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Constantin,
hier das Grundgerüst für ein solches Makro.
Falls in den zu kopierenden Zellen in Tabelle3/Tabelle4 Formeln stehen, dann muss das Kopieren der Daten noch etwas modifiziert werden (nur Werte oder Werte+Formate einfügen).
Gruß
Franz

Sub DatenSpeichern()
Dim wbk_1 As Workbook
Dim wks_3 As Worksheet, wks_4 As Worksheet
Dim wbk_2 As Workbook
Dim strUserName As String, datDatum As Date, datTime As Date
Dim strFileNameNew As String
Dim lngZeile As Long, StatusCalc As Long
Const strMappe2 As String = "C:\Users\Public\Test\ConstantinMappe2.xlsx" 'Anpassen !!!
If MsgBox("Daten jetzt in Datei """ & strMappe2 & """ speichern?", _
vbQuestion + vbOKCancel, "Daten speichern") = vbCancel Then Exit Sub
strUserName = VBA.Environ("Username")
datDatum = VBA.Date
datTime = VBA.Time
'Makro Bremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Objekte in aktiver Arbeitsmappe setzen
Set wbk_1 = ActiveWorkbook 'Aktive Arbeitsmappe mit dem Formular
Set wks_3 = wbk_1.Worksheets(3) '= wbk_1.Worksheets("Tabelle3")
Set wks_4 = wbk_1.Worksheets(4) '= wbk_1.Worksheets("Tabelle4")
'Username, Datum und Zeit eintragen
With wks_3
.Cells(2, 2).Value = strUserName
.Cells(2, 3).Value = datDatum
.Cells(2, 4).Value = datTime
End With
With wks_4
.Range(.Cells(2, 2), .Cells(3, 2)).Value = strUserName
.Range(.Cells(2, 3), .Cells(3, 3)).Value = datDatum
.Range(.Cells(2, 4), .Cells(3, 4)).Value = datTime
End With
'Zieldatei (Mappe2) öffnen
Set wbk_2 = Application.Workbooks.Open(Filename:=strMappe2)
'Werte nach Tabelle1 kopieren
With wbk_2.Worksheets(1) 'wbk_2.Worksheets("Tabelle1")
'letzte Datenzeile in Zieltabelle
lngZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
'Datenkopieren - Zellbereich ggf. anpassen
wks_3.Range("A2:D2").Copy Destination:=.Cells(lngZeile + 1, 1)
End With
'Werte nach Tabelle2 kopieren
With wbk_2.Worksheets(2) 'wbk_2.Worksheets("Tabelle2")
'letzte Datenzeile in Zieltabelle
lngZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
'Datenkopieren - Zellbereich ggf. anpassen
wks_4.Range("A2:D3").Copy Destination:=.Cells(lngZeile + 1, 1)
End With
'Mappe2 speichern und schliessen
wbk_2.Close savechanges:=True
'Mappe 1 unter neuem Namen speichern
With wbk_1
strFileNameNew = .Path & Application.PathSeparator & .Worksheets(1).Range("A50")
.SaveAs Filename:=strFileNameNew
End With
'Objekt-Variablen zurücksetzen
Set wbk_2 = Nothing
Set wbk_1 = Nothing: Set wks_3 = Nothing: Set wks_4 = Nothing
'Makro Bremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
.EnableEvents = True
End With
End Sub

Sub Werte_Format() ' Formeln ersetzen durch Werte mit Formate ' Workbooks("Datei1.xls").Worksheets("Tabelle1").Range(Sheets("Tabelle1").UsedRange.Address). _ Copy ' Vorschlag Verbesserrung NoNet Workbooks("Datei1.xls").Worksheets("Tabelle1").UsedRange.Copy With Workbooks("Datei2.xls").Worksheets("Tabelle1").Range("A1") .PasteSpecial Paste:=xlValues ' Werte .PasteSpecial Paste:=xlFormats ' Formate End With Application.CutCopyMode = False

Option Explicit Sub FormnateWerte() Dim strMappe2 As String Dim wbk_2 As Workbook Dim wks_3 As Worksheet Dim wks_4 As Worksheet Dim lngZeile As Long strMappe2 = "C:\Hallo.xlsm" Set wks_3 = ActiveSheet Set wks_4 = ActiveSheet 'Zieldatei (Mappe2) öffnen Set wbk_2 = Application.Workbooks.Open(Filename:=strMappe2) 'Werte nach Tabelle1 kopieren With wbk_2.Worksheets(1) 'wbk_2.Worksheets("Tabelle1") 'letzte Datenzeile in Zieltabelle lngZeile = .Cells(.Rows.Count, 2).End(xlUp).Row 'Datenkopieren - Zellbereich ggf. anpassen wks_3.Range("A2:D2").Copy .Cells(lngZeile + 1, 1).PasteSpecial Paste:=xlValues ' Werte .Cells(lngZeile + 1, 1).PasteSpecial Paste:=xlFormats ' Formate End With 'Werte nach Tabelle2 kopieren With wbk_2.Worksheets(2) 'wbk_2.Worksheets("Tabelle2") 'letzte Datenzeile in Zieltabelle lngZeile = .Cells(.Rows.Count, 2).End(xlUp).Row 'Datenkopieren - Zellbereich ggf. anpassen wks_4.Range("A2:D3").Copy .Cells(lngZeile + 1, 1).PasteSpecial Paste:=xlValues ' Werte .Cells(lngZeile + 1, 1).PasteSpecial Paste:=xlFormats ' Formate End With Application.CutCopyMode = False Set wbk_2 = Nothing Set wks_3 = Nothing Set wks_4 = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Zeilen von Mappe1 in Mappe2 anfügen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen von Mappe1 in Mappe2 anfügen

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

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread