Spalten kopieren und in andere Datei einfügen

parza · 2018-11-01T11:28:54+00:00

Hallo Fachleute, mit Hilfe von Google habe ich unten stehendes Makro gefunden. Ob es wirklich gut so ist, weiß ich nicht, aber es funktionert zunächst mal. Ziel ist es, aus einer Tabelle (Sheet Personal) ausgewählte Spalten zu kopieren und woanders einzufügen. DIn meinem Makro fügt er die Inhalte aber in die gleiche Datei unter Sheet KE ein. Ich hätte aber gern, dass er sie in eine andere, noch nicht geöffnete Datei z.B. C:\Test\test.xls an der Position B5 einfügt. Ich wäre euch sehr dankbar für die Unterstützung. parza Option Explicit Sub kopieren() Dim Spalte As Variant, intI As Integer Spalte = Array(10, 11, 24, 28, 31) Application.ScreenUpdating = False For intI = 0 To 4 Worksheets("Personal").Select Range(Cells(3, Spalte(intI)), Cells(Worksheets("Personal").Cells(Rows.Count, Spalte( _ intI)).End(xlUp).Row, Spalte(intI))).Copy Worksheets("KE").Select Cells(3, intI + 1).Select ActiveSheet.Paste Application.CutCopyMode = False Next Range("B5").Select Application.ScreenUpdating = True End Sub

Hallo,
dann so:

Option Explicit
Sub kopieren()
Dim intI As Integer, loZeileZiel As Long, loSpalteZiel As Long
Dim wbZiel As Workbook, wsZiel As Worksheet, Spalte As Variant
'festlegen der Zielzeile
loZeileZiel = 5
'festlegen der Zielspalte (Startspalte) A=1, B=2 ...
loSpalteZiel = 2
Spalte = Array(10, 11, 24, 28, 31)
Application.ScreenUpdating = False
'Datei öffnen und Zielblatt zuweisen
Set wbZiel = Workbooks.Open("C:\Test\test.xlsx")
Set wsZiel = wbZiel.Worksheets("Der_Name_des_Zielblattes")
For intI = 0 To 4
With ThisWorkbook.Worksheets("Personal")
'Bereich kopieren
.Range(.Cells(3, Spalte(intI)), .Cells(.Cells(.Rows.Count, _
Spalte(intI)).End(xlUp).Row, Spalte(intI))).Copy
With wsZiel
'kopierte Daten als Werte einfügen
.Cells(loZeileZiel, loSpalteZiel).PasteSpecial Paste:=xlPasteValues
loSpalteZiel = loSpalteZiel + 1
End With
End With
Next
'Zielblatt speichern und schließen
wbZiel.Close True
'Kopierspeicher leeren
Application.CutCopyMode = False
'Variablen aufräumen
Set wbZiel = Nothing: Set wsZiel = Nothing
End Sub

Gruß Werner

Hallo Werner, hallo Fachleute,
danke nochmals für eure große Unterstützung gestern. Ich habe nun den Code in die Originaldatei eingefügt. Unterschied sind Dateinamen und Dateipfad (ist unerheblich und funktioniert). Eine große Änderung ist, dass es im Original mehr Spalten = Arrays sind.
Nun zum Problem und was ich durch Versuch/Irrtum herausgefunden habe:
Lasse ich den Code "For intI = 0 To 4" so wie im Originalcode von Werner, läuft alles durch, allerdings werden nur 5 Spalten kopiert und eingefügt.
Ändere ich "For intI = 0 To 20" kommt ein Debugging (gelb markiert) mit Laufzeitfehler 9 bei diesen Zeilen
.Range(.Cells(3, Spalte(intI)), .Cells(.Cells(.Rows.Count, _
Spalte(intI)).End(xlUp).Row, Spalte(intI))).Copy
Beende ich nun das Debuggen, ist trotzdem alles an der richtigen Stelle und komplett eingefügt und kopiert.
Hat noch jemand eine Idee?
parza
Option Explicit

Sub KE_erstellen()
Dim intI As Integer, loZeileZiel As Long, loSpalteZiel As Long
Dim wbZiel As Workbook, wsZiel As Worksheet, Spalte As Variant
'festlegen der Zielzeile
loZeileZiel = 3
'festlegen der Zielspalte (Startspalte) A=1, B=2 ...
loSpalteZiel = 3
Spalte = Array(10, 11, 16, 17, 23, 24, 25, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 43)
Application.ScreenUpdating = False
'Datei öffnen und Zielblatt zuweisen
Set wbZiel = Workbooks.Open("Q:\4\41\AllgemeinesSG41\Zusammenarbeit\Kostenersatz\18_19\xxxx  _
KE_18_19.xls")
Set wsZiel = wbZiel.Worksheets("Tabelle1")
For intI = 0 To 20
With ThisWorkbook.Worksheets("Personal")
'Bereich kopieren
.Range(.Cells(3, Spalte(intI)), .Cells(.Cells(.Rows.Count, _
Spalte(intI)).End(xlUp).Row, Spalte(intI))).Copy
With wsZiel
'kopierte Daten als Werte einfügen
.Cells(loZeileZiel, loSpalteZiel).PasteSpecial Paste:=xlPasteValues
loSpalteZiel = loSpalteZiel + 1
End With
End With
Next
'Zielblatt speichern und schließen
'wbZiel.Close True
'Kopierspeicher leeren
Application.CutCopyMode = False
'Variablen aufräumen
Set wbZiel = Nothing: Set wsZiel = Nothing
End Sub

Spalten kopieren und in andere Datei einfügen

Forumthread: Spalten kopieren und in andere Datei einfügen

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial