Office: Spalten abfragen und aus anderer Datei kopieren

GregMichel · 3. November 2013

Hallo Zusammen,

ich hoffe mir kann jemand helfen. Ich will gerade ein Macro schreiben, dass folgendes kann: Ich habe eine Projektübersicht, in der in Spalte B in jeder 14ten Zeile eine Projektnummer steht. Das Makro soll jetzt die Pojektnummer lesen und aus einer anderen Datei das entsprechende Worksheet öffnen und da den Wert aus A1 kopieren. Ich habe es jetzt mit einer Projektnummer geschafft, muss es halt "nur noch so weiter" bearbeiten, dass er wie gesagt jede 14te Zeile ausliest.

Set wsZiel = ActiveWorkbook.ActiveSheet
Projektname = wsZiel.Range("B26") 'Hier muss er jetzt nicht nur den Wert aus B26, sondern aus jeder Zeile mit B26 + n*14 Zeilen bis eine Leerzeile kommt raussuchen
Set wsQuelle = Workbooks.Open(Filename:="D:\Dateien\Projektübersicht").Worksheets(Projektname)
wsQuelle.Range("A1").Copy
wsZiel.Range("D40").PasteSpecial Paste:=xlPasteValues
wsQuelle.Parent.Close

Bitte um eure Hilfe

:)

Hajo_Zi · 5. November 2013

Code:

Dim Loi As Long
Set wsZiel = ActiveWorkbook.ActiveSheet
For Loi = 26 To 1048576 Step 14
Projektname = wsZiel.Cells(Loi, 2) 'Hier muss er jetzt nicht nur den Wert aus B26, sondern aus jeder Zeile mit B26 + n*14 Zeilen bis eine Leerzeile kommt raussuchen
Set wsQuelle = Workbooks.Open(Filename:="D:\Dateien\Projektübersicht").Worksheets(Projektname)
wsQuelle.Range("A1").Copy
wsZiel.Range("D40").PasteSpecial Paste:=xlPasteValues
wsQuelle.Parent.Close
Next Loi
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

GregMichel · 5. November 2013

Super vielen Dank. Es funktioniert bis aus die Tatsache, dass die Datei Projektübersicht jetzt nicht mehr schließt. Weiß jemand woran das liegen kann?

Hajo_Zi · 5. November 2013

für die Abarbeitung von 1.048.576 Zeilen sollte man schon ein wenig Zeit einplanen.

GregMichel · 5. November 2013

Okay vielen Dank. Da du mir so super hilfst habe ich zwei weitere Fragen:

1) Kann man den Code so ändern, das er bei der ersten Leerzeile aufhört zu arbeiten?

2) Ich habe jetzt ja nur um das Kopieren erweitert. Wie würde der entsprechende Paste Befehl ausschauen?

Bisher: wsZiel.Range("D40").PasteSpecial Paste:=xlPasteValues

So dass er nicht mehr in D40 einfügt sondern auch alle 14-Zeilen

Hajo_Zi · 5. November 2013

lege das ende fest
LoLetzte = IIf(IsEmpty(Cells(Rows.Count,2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
To loletzte
2 Stand nicht in der Aufgabe.
wsZiel.Cells(Loi+14 ,4) ......

GregMichel · 5. November 2013

Weiterhin vielen Dank für deine Hilfe. Das Programm funktioniert super, schließt nur leider immer noch nicht -.- (Auch wenn ich eine Stunde warte)

Code:

Sub Aktualisieren()
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim Projektname As String
Dim Loi As Long
Dim loletzte As Long

On Error GoTo FEHLER
'
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Set wsZiel = ActiveWorkbook.ActiveSheet
loletzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)

For Loi = 8 To loletzte Step 18
Projektname = wsZiel.Cells(Loi, 2)
Set wsQuelle = Workbooks.Open(Filename:="D:\Eigene Daten\Projektübersicht.xlsx").Worksheets(Projektname)
wsQuelle.Range("A1").Copy
wsZiel.Cells(Loi + 14, 4).PasteSpecial Paste:=xlPasteValues
Next Loi

FEHLER:
With Application

.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hajo_Zi · 5. November 2013

hast Du mal strg+ende mit Deinem Ende der Tabelle überprüft?
nach der letzten Zeile bis min. 2 Zeilen über Strg+Ende löschen und speichern.

GregMichel · 5. November 2013

Jetzt habe ich den Fehler gefunden, eine Projektnummer war falsch geschrieben. Ich habe sie korrigiert und es schließt ohne Probleme. Kann ich das nicht trotz einer falscher Projektnummer schließen lassen?

Office: Spalten abfragen und aus anderer Datei kopieren

Spalten abfragen und aus anderer Datei kopieren

Spalten abfragen und aus anderer Datei kopieren

Spalten abfragen und aus anderer Datei kopieren

Spalten abfragen und aus anderer Datei kopieren

Spalten abfragen und aus anderer Datei kopieren - Similar Threads - Spalten abfragen Datei

Leere Spalte zu einer Abfrage hinzufügen

SVerweis, WennDann oder Makro

Primärschlüssel/Fremdschlüssel aus 2.Tabelle automatisch einfügen

Radoibutton Abfrage - Spalten einblenden

Alle Spalten einer Abfrage nach einem String filtern

Wert aus einer Spalte in andere mit eine Abfrage

Abfrage mit mehreren Spalten, DISTINCT nur auf eine Spalte anwenden