Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Getrennte Zellen kopieren und in neuer Datei nebeneinander einfügen

Getrennte Zellen kopieren und in neuer Datei nebeneinander einfügen
23.01.2020 08:10:24
molch75
Guten Morgen zusammen,
Ich möchte folgendes durchführen:
Aus der geschlossenen Datei: XYZ, sollen die Zellen F5, B5, D5, F8 und der Bereich B14 bis B104 kopiert werden und in die nächste freie Spalte in der geöffneten Datei: Master, nebeneinander eingefügt werden.
Vielen Dank im Voraus.
Gruß

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Getrennte Zellen kopieren
23.01.2020 10:14:57
Nepumuk
Hallo,
teste mal:
Option Explicit
Public Sub Import()
Dim objWorkbook As Workbook
Dim objTargetSheet As Worksheet
Dim lngEmptyRow As Long
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set objTargetSheet = ThisWorkbook.Worksheets("Tabelle1") 'Anpassen !!!
With objTargetSheet
lngEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
End With
Set objWorkbook = Workbooks.Open(Filename:= _
"D:\XYZ.xlsx", ReadOnly:=True) 'Pfad anpassen !!!
With objWorkbook.Worksheets("Tabelle1") 'Anpassen !!!
Call .Range("F5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 1))
Call .Range("B5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 2))
Call .Range("D5").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 3))
Call .Range("F8").Copy(Destination:=objTargetSheet.Cells(lngEmptyRow, 4))
Call .Range("B14:B104").Copy
Call objTargetSheet.Cells(lngEmptyRow, 2).PasteSpecial( _
Paste:=xlPasteAll, Transpose:=True)
End With
Application.CutCopyMode = False
Call objWorkbook.Close(SaveChanges:=False)
Set objWorkbook = Nothing
Set objTargetSheet = Nothing
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Gruß
Nepumuk
Anzeige
AW: Getrennte Zellen kopieren
23.01.2020 13:06:24
molch75
Hallo,
1000 Dank, es funktioniert :D
Ich musste allerdings bei
Call objTargetSheet.Cells(lngEmptyRow, 2).PasteSpecial( _
Paste:=xlPasteAll, Transpose:=True)
die 2 durch die 5 ersetzen.
Nochmals vielen Dank für die schnelle Hilfe!
Gruß

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige