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

Importwerte über Makro in freie Spalte kopieren

Importwerte über Makro in freie Spalte kopieren
Philipp
Hallo Forumsmitglieder,
ich benötige Hilfe bei folgendem Vorhaben:
Ausgangssituation:
Beim Drücken auf eine Schaltfläche 1 werden bestehende Zeilen und Spalten über ein Makro kopiert und neben der letzten bestehenden Spalte eingefügt (Schritt 1). Nun habe ich ein weiteres Makro angelegt, welches per Drücken auf eine Schaltfläche 2 aus drei Excel-Dateien-B genau definierte Werte aus einer Spalte in ein Arbeitsblatt in einer Excel-Datei-A kopiert (Schritt 2).
Ziel soll nun sein, dass dieser Vorgang mehrere Male wieder holt wird: Man kopiert über Schaltfläche 1 einen vorgegebenen Bereich aus Zeilen und Spalten, fügt ihn an die nächste freie Spalte an und kann im nächsten Schritt über die Schaltfläche 2 die Daten in den angelegten Bereich kopieren.
Schritt 1 funktioniert einwandfrei. Ich habe es allerdings nicht geschafft, dass mein Makro beim Schritt 2 ebenfalls in den nächsten freien Bereich - in dem sich noch keine Werte befinden - kopiert.
Ich hoffe ihr habt mein Problem verstanden und ihr könnt mir helfen. Gerne gebe ich auch den _ Code bekannt, den ich bereits programmiert habe:

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

Vielen Dank!
MfG,
Philipp

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

Betreff
Benutzer
Anzeige
AW: Importwerte über Makro in freie Spalte kopieren
27.06.2012 17:45:26
Philipp
Ganz vergessen: Eine - für mich - gute Möglichkeit wäre, wenn die Werte in die Spalte kopiert werden würden, die man mit der Maus markiert hat. Wie heißt das entsprechende Makro dazu?
AW: Importwerte über Makro in freie Spalte kopieren
02.07.2012 21:13:44
fcs
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

Anzeige

331 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige