Werte aus C:/Datei x in D:/Datei y speichern

Liebes Forum,
bin blutiger VBA Anfänger.
Wie kann man am einfachsten aus einer Datei x (im Prinzip ist es eine Eingabemaske) die Werte in eine andere Datei die sich auf einem anderen Laufwerkbefindet in einer Tabelle wegspeichern?
https://www.herber.de/bbs/user/62149.xls
https://www.herber.de/bbs/user/62150.xls
Vielen Dank für eure Hilfe im voraus
Peter
Hintergrund:
Ich habe ca. 30 Projekte, wobei immer neue dazu kommen.
Jedes Projekt hat ein gleiches Übersichtsblatt X (Projektnummer, Projektnamen, Bearbeiter, technische und finanzielle Daten, etc.) Die Daten sind zum Teil vertraulich.
Zwecks besserer Übersicht soll aus diesen verschiedenen Übersichtsblättern bestimmte Daten in einer anderen Datei Y, die allen zugänglich ist zusammengefasst werden. Diese Datei befindet sich auf einem freigegebenen Laufwerk.
Ich möchte nun jedem Übersichtsblatt X ein Makro anhängen, mit dem es möglich ist, auf "Knopfdruck" zu sagen: Speicher die Werte in die Datei Y (es entsteht somit eine Übersichtstabelle über alls Projekte). Diese Datei Y dient gleichzeitig als Diskussionsvorlage in Lenkungsgrämien.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Uebertrag() Dim arrQ, arrW(1 To 6), wkbSamm As Workbook Const strPf As String = "f:\exc\w-w-w\tmp\Peter_Samm.xls" ' anpassen arrQ = Application.Transpose(Sheets("Werte-Eingabe").Range("B5:B13").Value) arrW(1) = arrQ(1) ' Eingabeblatt arrW(2) = arrQ(3) arrW(3) = arrQ(4) arrW(4) = arrQ(6) arrW(5) = arrQ(7) arrW(6) = arrQ(9) ' Application.ScreenUpdating = False ' NACH DEM TEST aktivieren Set wkbSamm = Workbooks.Open(strPf) With wkbSamm.Sheets("Werte-Eingabe") ' Ausgabeblatt .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6) = arrW End With wkbSamm.Close True Application.ScreenUpdating = True MsgBox "Übertrag erledigt" End Sub

Sub Uebertrag() Dim arrQ, arrW(1 To 15), wkbSamm As Workbook Const strPf As String = "C:\Dokumente und Einstellungen\tkaczuk\Eigene Dateien" & _ "\Excel-dateien\Excel-Funktions-Beispiele\VBA\XXX.xls" ' anpassen arrQ = Application.Sheets("Projektverlauf").Range("A1:F30").Value arrW(1) = arrQ(1, 1) ' Eingabeblatt arrW(2) = arrQ(2, 2) arrW(3) = arrQ(4, 6) arrW(4) = arrQ(6, 6) arrW(5) = arrQ(4, 2) arrW(6) = arrQ(6, 2) arrW(7) = arrQ(13, 2) arrW(8) = arrQ(14, 2) arrW(9) = arrQ(17, 2) arrW(10) = arrQ(18, 2) arrW(11) = arrQ(19, 2) arrW(12) = arrQ(21, 2) arrW(13) = arrQ(22, 2) arrW(14) = arrQ(23, 2) arrW(15) = arrQ(30, 6) 'Application.ScreenUpdating = False ' NACH DEM TEST aktivieren Set wkbSamm = Workbooks.Open(strPf) With wkbSamm.Sheets("Tabelle1") ' Ausgabeblatt .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arrW)) = arrW End With wkbSamm.Close True Application.ScreenUpdating = True MsgBox "Übertrag erledigt" End Sub

Hi Peter,
sollen die Werte in Tab2 auch ab Spalte A, jeweils in eine neue Zeile geschrieben werden?
Dann könnte das so funzen:


Option Explicit
Sub Uebertrag()
Dim arrQ, arrW(1 To 13), wkbSamm As Workbook, lngZ As Long
Const strPf As String = _
"C:\Dokumente und Einstellungen\tkaczuk\Eigene Dateien" & _
"\Excel-dateien\Excel-Funktions-Beispiele\VBA\XXX.xls"       ' anpassen
arrQ = Application.Sheets("Projektverlauf").Range("A1:F30").Value
arrW(1) = arrQ(1, 1)                  ' Eingabeblatt
arrW(2) = arrQ(2, 2)
arrW(3) = arrQ(4, 6)
arrW(4) = arrQ(6, 6)
arrW(5) = arrQ(4, 2)
arrW(6) = arrQ(6, 2)
arrW(7) = arrQ(13, 2)
arrW(8) = arrQ(14, 2)
arrW(9) = arrQ(17, 2)
arrW(10) = arrQ(18, 2)
arrW(11) = arrQ(19, 2)
arrW(12) = arrQ(21, 2)
arrW(13) = arrQ(22, 2)
'Application.ScreenUpdating = False         ' NACH DEM TEST aktivieren
Set wkbSamm = Workbooks.Open(strPf)
With wkbSamm.Sheets("Tabelle1")         ' Ausgabeblatt 1
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(arrW)) = arrW
End With
With wkbSamm.Sheets("Tabelle2")         ' Ausgabeblatt 2
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngZ, 1) = arrQ(23, 2)
.Cells(lngZ, 2) = arrQ(30, 6)
End With
wkbSamm.Close True
Application.ScreenUpdating = True
MsgBox "Übertrag erledigt"
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Werte aus C:/Datei x in D:/Datei y speichern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread