Werte aus einer Datei in eine andere Datei schreib
14.10.2017 01:37:21
Bernd
ich dachte, ich könnte mal ein Makro schreiben. Leider sitze ich schon bis in die Nacht und bekomme es nicht hin.
Ich habe eine Datei, in der stehen über das Blatt verteilt 5 Werte. Diese möchte ich per Makro in eine andere Datei schreiben und zwar in Tabellenform. Das Makro soll das Ende der Tabelle suche und in die nächste freie Zeile die 5 Werte nebeneinander schreiben.
Gibt es einen ähnlichen befehl wie:
Workbook1.Sheet1.Range("D4").copy = Workbook2.Sheet1.Range(AktiveZelle).paste
So dass man nicht immer zwischen den Dateien springen muss?
Das Makro läuft in einer dritten ausgeblendeten .xlsm Datei
In Datei 116957.xlsx befinden sich die Daten
https://www.herber.de/bbs/user/116957.xlsx
In Datei 116958 befindet sich die Tabelle, in die die Daten eingefügt werden sollen.
https://www.herber.de/bbs/user/116958.xlsx
Hier mein bisheriger Versuch:
Public Sub Ergebnisse_in_Tabelle_schreiben()
Dim sPfad As String ' der Ordner-Pfad der Excel-Mappen
Dim sDatei As String ' die zu beschreibende Datei
Dim LetzteZeile As Integer ' Letzte Zeile der Ergebnistabelle suchen
Dim Datei_Q As Workbook ' die Quelldatei
Dim WkSh_Q As Worksheet ' das Quell-Tabellenblatt - die Herkunft
Dim WkSh_Z As Worksheet ' das Ziel-Tabellenblatt - das Ergebnis
Dim SampleNo As String
Dim Description As String
Dim Merit As Single
Dim Temp As Single
Dim DateOfTest As Date
sPfad = "C:\Apps\"
sDatei = "116958.xlsx"
'Application.ScreenUpdating = False
Set Datei_Q = ActiveWorkbook
If Dir(sPfad & sDatei) "" Then
Workbooks.Open (sPfad & sDatei)
'Application.ActiveWindow.Visible = False
'Letze Zeile suchen
Workbooks(sDatei).Activate
ActiveSheet.Range("A1").Select
LetzteZeile = Range("A1", Range("A1").End(xlDown)).Cells.Count + 1
Datei_Q.Activate
Else
MsgBox "Den angegebenen Ordner """ & sPfad & """" & Chr(10) & _
"und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
16, " Hinweis für " & Application.UserName
Exit Sub
End If
Set WkSh_Q = Datei_Q.Worksheets("MCT")
Set WkSh_Z = Workbooks(sDatei).Worksheets("Tabelle1")
'Kopieren und einfügen
'****** Hier komme ich nicht weiter ******
Workbooks(sDatei).Activate
WkSh_Z.Cells(LetzteZeile, 1).Select
WkSh_Z.Cells(LetzteZeile, 1) = ActiveCell.Offset(-1, 0).Value + 1
ActiveCell.Offset(0, 1).Select
'WkSh_Q.Range("DateOfTest").Copy = WkSh_Z.Range("AktiveZelle").Paste
ActiveCell.Offset(0, 1).Select
Application.CutCopyMode = False
'Workbooks(sDatei).Close SaveChanges:=True
'Application.ScreenUpdating = True
'MsgBox "Die Ergebnisse wurden erfolgreich gespeichert.", _
64, " Information für " & Application.UserName
End Sub