Werte in andere Tabelle kopieren

Liebe Excel/VBA-Fangemeinde,
ich weiß es ist nicht besonders originell, das Thema, aber trotzdem kann es einen
ganz schön ärgern. Kopieren in eine andere Datei.
Ich versuche (nur) die Werte aus Datei 1, Tabellle 1, Range("GW3:GW15")und Range("GW25:GW104") in eine andere Datei, Datei 2, Tabelle 1, (jeweils in die nächste freie Spalte ab Zeile 20 bis Zeile 32 und Zeile 42 bis 103) einzufügen.
Also:
Daten in Datei 1 kopieren, Check ob Datei 2 geöffnet, Datei 2 öffnen, Daten in Datei 2 einfügen,
Datei2 speichern und offen lassen, dann wieder zurück zu Datei 1.
Was ich dazu bisher online gefunden habe, war zu kompliziert oder funktionierte bei mir nicht.
Kann mir jemand helfen?
Danke,
Born

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Born,
so z.B..:


Sub DatenEinfügen()
Dim wb As Workbook, ws As Worksheet, ws2 As Worksheet
Dim efs%, Verz$
Application.ScreenUpdating = False
Set ws2 = ThisWorkbook.Worksheets("Tabelle1")
Verz = "C:\Daten\Excel\"
If MappeOffen("Datei2.xls") Then
Workbooks("Datei2.xls").Activate
Set wb = ActiveWorkbook
Else
ChDrive Left(Verz, 1)
Workbooks.Open Filename:=Verz & "Datei2.xls"
Set wb = ActiveWorkbook
End If
Set ws = wb.Worksheets(1)
efs = ws2.Cells(20, Columns.Count).End(xlToLeft).Column
ws.Range("GW3:GW15").Copy ws2.Cells(20, efs)
ws.Range("GW25:GW104").Copy ws2.Cells(42, efs)
wb.Save
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Function


Function MappeOffen(MappeName As String) As Boolean
Dim stName As String
On Error GoTo NichtOffen
stName = Workbooks(MappeName).Name
MappeOffen = True
Exit Function
NichtOffen:
MappeOffen = False
End Function

Datei- und Tabellennamen, sowie Pfad anpassen.
Gruß
Heinz

Sub DatenEinfügen() Dim wb As Workbook, ws As Worksheet, ws2 As Worksheet Dim efs%, Verz$ Application.ScreenUpdating = False '** Diese Datei mit dem Makro: Set ws2 = ThisWorkbook.Worksheets("Tabelle1") '** Ordner der einzulesenden Datei: Verz = "C:\Daten\Excel\" '** Öffnen oder aktivieren der einzulesenden Datei: If MappeOffen("Datei2.xls") Then Workbooks("Datei2.xls").Activate Set wb = ActiveWorkbook Else ChDrive Left(Verz, 1) Workbooks.Open Filename:=Verz & "Datei2.xls" Set wb = ActiveWorkbook End If '** Tabelle1 der einzulesenden Datei: Set ws = wb.Worksheets(1) '** Suchen der ersten freien Zeile dieser Datei, in die kopiert wird: efs = ws2.Cells(20, Columns.Count).End(xlToLeft).Column + 1 '** Kopieren der beiden Werte aus der Tabelle1 der einzulesenden Datei (ws) '** in die Tabelle1 dieser Datei (ws2): ws.Range("GW3:GW15").Copy ws2.Cells(20, efs) ws.Range("GW25:GW104").Copy ws2.Cells(42, efs) '** Speichern der einzulesenden Datei: wb.Save '** Speichern dieser Datei: ThisWorkbook.Save '** Aktivieren dieser Datei: ThisWorkbook.Activate Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte in andere Tabelle kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread