Importwerte über Makro in freie Spalte kopieren

Sub AImportXXX () ' AImportXXX ' Tastenkombination: Strg+i Dim strPfad As String strPfad = Tabelle29.Cells(1, 1) 'TODO_ Hier die richtige Tabelle, Zeile und Spalte _ eintragen If Right(strPfad, 1) "\" Then strPfad = strPfad & "\" Range("H9:K127").Select Selection.Copy ActiveWindow.SmallScroll Down:=-96 GetNextFreeCell.Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste ChDir strPfad Workbooks.Open Filename:=strPfad & "XXX1.xlsx" Range("D4:D46").Select Application.CutCopyMode = False Selection.Copy Windows("XXX.xlsm").Activate Range("M12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Workbooks.Open Filename:=strPfad & "XXX2.xlsx" Range("D4:D13").Select Application.CutCopyMode = False Selection.Copy Windows("XXXKopie7.xlsm").Activate ActiveWindow.SmallScroll Down:=36 Range("M62").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Workbooks.Open Filename:=strPfad & "XXX3.xlsx" Range("D4:D50").Select Application.CutCopyMode = False Selection.Copy Windows("XXXKopie7.xlsm").Activate ActiveWindow.SmallScroll Down:=15 Range("M79").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Philipp,
wenn mehrere Dateien in Kopiervorgänge involviert sind, dann sollte man unbedingt mit Objekt-Variablen arbeiten. Das erspart die leidigen Activate und Select-Aktionen.
Scroll-Befehle sind in Makros fast immer nicht erforderlich. Ausnahme evtl. wenn dem Anweder am Ende des Makros ein bestimmter Ausschnitt eines Tabellenblatts angezeigt werden soll.
Dein Code ist etwas verwirrend:
Als Zieldatei für das Kopieren aus den 3 geöffneten Datein gibt es sowohl "XXX.xlsm" als auch "XXXKopie7.xlsm"
Weiter Fragen:
1. Welche Datei ist beim Start des Makros die aktive Datei? XXXKopie7.xlsm ?
2. In welchem Tabellenblatt sucht "GetNextFreeCell" die freie Zelle? Aktives Tabelleblatt?
3. In welche Datei/Tabellen werden die Daten kopiert? Aktive Datei, aktives Tabellenblatt?
4. Wo sollen die Daten aus den 3 Dateien gebau eingefügt werden?
Im Prinzip funktioniert dann folgendes Makro. Müsste aber abhängig von den Antworten angepasst/vereinfacht werden. Die Daten aus den 3 Dateien werden relativ zur Einfügezelle des 1. Kopiervorgangs eingefügt. Da müsstets du noch genau festlegen wo das sein soll. Einfach mal in einer Testdatei probieren und dann anpassen.
Man kann die aktuell selektierte Spalte/Zelle auch einfach als Einfüge-Spalte festlegen, sollte man aber nur machen, wenn man es nicht per Makro automatisieren kann, da sonst schnell mal Daten versehentlich überschrieben werden.
Zu Beginn des Makros :
lngSpalte = ActiveCell.Column
als Zielzelle für das Kopieren dann z.B.
Set rngZiel = ActiveSheet.Cells(1, lngSpalte)
Gruß
Franz

Sub AImportXXX()
' AImportXXX
' Tastenkombination: Strg+i
Dim wkbAktiv As Workbook, wksAktiv As Worksheet
Dim wkbQuelle As Workbook
Dim wbkZiel As Workbook, wksZiel As Worksheet, rngZiel As Range
Dim strPfad As String
Application.ScreenUpdating = False
Set wkbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
strPfad = Tabelle29.Cells(1, 1) 'TODO_ Hier die richtige Tabelle, Zeile und Spalte _
eintragen
If Right(strPfad, 1)  "\" Then strPfad = strPfad & "\"
wksAktiv.Range("H9:K127").Copy
Set rngZiel = GetNextFreeCell
Set wksZiel = rngZiel.Parent
Set wbkZiel = wksZiel.Parent
rngZiel.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
rngZiel.PasteSpecial xlPasteAll
Application.CutCopyMode = False
ChDir strPfad 'Überflüssig für das Makro!!
Set wkbQuelle = Workbooks.Open(Filename:=strPfad & "XXX1.xlsx", ReadOnly:=True)
wkbQuelle.Worksheets(1).Range("D4:D46").Copy
wksZiel.Cells(12, rngZiel.Column + 5).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
wkbQuelle.Close savechanges:=False
Set wkbQuelle = Workbooks.Open(Filename:=strPfad & "XXX2.xlsx", ReadOnly:=True)
wkbQuelle.Worksheets(1).Range("D4:D13").Copy
wksZiel.Cells(62, rngZiel.Column + 5).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
wkbQuelle.Close savechanges:=False
Set wkbQuelle = Workbooks.Open(Filename:=strPfad & "XXX3.xlsx", ReadOnly:=True)
wkbQuelle.Worksheets(1).Range("D4:D50").Copy
wksZiel.Cells(79, rngZiel.Column + 5).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
wkbQuelle.Close savechanges:=False
Application.ScreenUpdating = True
'Objektvariablen zurücksetzen
Set wkbAktiv = Nothing: Set wksAktiv = Nothing
Set wkbQuelle = Nothing
Set wbkZiel = Nothing: Set wksZiel = Nothing: Set rngZiel = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

Importwerte über Makro in freie Spalte kopieren

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

329 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Importwerte über Makro in freie Spalte kopieren

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

329 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread