Spez Nummer aus Datei in spez Spalte zuordnen VBA

Forumthread: Spez Nummer aus Datei in spez Spalte zuordnen VBA

08.09.2016 11:31:07

Marsl

Hallo,
bin irgendwie ratlos.
Habe 80-100 Excel Dateien, alle mit einem anderen Namen die in eine Übersicht in eine definierte Spalte sollen.
Beispielsweise steht in der Übersicht in
A1 - 23
B1 - 340
C1 - 57849
usw
Die Anzahl ist flexibel und wird sich monatlich verändern.
Die Excel Dateien im Ordner haben den gleichen Wert in Spalte C1 stehen sprich jeder Wert in der Übersicht hat ein Pendant als Excel Datei. Es sollen dann die Zeilen C4 - Cn in die Übersicht kopiert werden.
Das Problem macht mir hier die Zuordnung, also wie bekomme ich es hin, dass er die Daten aus der Datei 123 in die Spalte 123 x4- xn und die Daten aus Datei 456 in die Spalte 456 x4- xn zuordnet?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Teste mal...

08.09.2016 13:23:57

Michael

Hallo!
Meine Annahmen, so ich Dich verstanden habe: In der Übersichts-Datei stehen in der ersten Zeile (ab A1) Werte, diese Werte stehen in den Quell-Dateien jeweils in C1. Alle Quell-Dateien in einem bestimmten Pfad werden geöffnet, und deren Bereich C4:Cx (x = letzte befüllte Zelle in C:C) wird in die Spalte der Übersichtsdatei kopiert, die den C1-Wert in der ersten Zeile enthält, und zwar ab der zweiten Zeile.
Teste mal:

Sub SpaltenHolen()
Const R_ID$ = "C1"
Const PFAD$ = "U:\Test\" ' 0
Set WbQ = Workbooks.Open(PFAD & Datei)
Set WsQ = WbQ.Worksheets(1)
ID = WsQ.Range(R_ID).Value
With WsZ
Set rSuch = .Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight))
Sp = Application.Match(ID, rSuch, 0)
If Not IsError(Sp) Then
With WsQ
.Range("C4:C" & .Cells(.Rows.Count, 3).End(xlUp).Row).Copy
End With
.Cells(2, Sp).PasteSpecial xlPasteValuesAndNumberFormats
End If
End With
WbQ.Close False
Datei = Dir
Loop
Application.ScreenUpdating = True
Set WbZ = Nothing
Set WsZ = Nothing
Set WbQ = Nothing
Set WsQ = Nothing
Set rSuch = Nothing
End Sub

LG
Michael

AW: Teste mal...

08.09.2016 14:36:27

Marsl

Danke erstmal.
Habs jetzt so abgeändert

Sub SpaltenHolen()
Const R_ID$ = "E2"
Const PFAD$ = "M:\August\"
Dim WbZ As Workbook
Dim WsZ As Worksheet
Dim WbQ As Workbook
Dim WsQ As Worksheet
Dim rSuch As Range
Dim Datei$, Sp, ID
Application.ScreenUpdating = False
Set WbZ = ThisWorkbook
Set WsZ = WbZ.Worksheets(1)
Datei = Dir(PFAD)
If Len(Datei) = 0 Then
MsgBox "Keine Dateieien gefunden in: " & PFAD, vbInformation, "Hinweis"
Exit Sub
End If
Do While Len(Datei) > 0
Set WbQ = Workbooks.Open(PFAD & Datei)
Set WsQ = WbQ.Worksheets(1)
ID = WsQ.Range(R_ID).Value
With WsZ
Set rSuch = .Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight))
Sp = Application.Match(ID, rSuch, 0)
If Not IsError(Sp) Then
With WsQ
.Range("E5:E" & .Cells(.Rows.Count, 3).End(xlUp).Row).Copy
End With
.Cells(2, Sp).PasteSpecial xlPasteValuesAndNumberFormats
End If
End With
WbQ.Close False
Datei = Dir
Loop
Application.ScreenUpdating = True
Set WbZ = Nothing
Set WsZ = Nothing
Set WbQ = Nothing
Set WsQ = Nothing
Set rSuch = Nothing
End Sub

er öffnet wohl auch die Dateien, aber es wird nichts in die Übersicht kopiert :-/

Naja, das kommt eben darauf an...

08.09.2016 15:00:34

Michael

Marsl,
... wie Deine Quell-Tabellenblätter so aufgebaut sind. Aufpassen musst Du bei folgenden Zeile im Code:

Const R_ID$ = "E2"

Hier legst Du fest in welcher Zelle der Quelldatei jener Wert steht, nach dem die Ziel-Spalte bestimmt wird. In Deinem ersten Beitrag war das noch C1. Wenn in dieser Zelle kein Wert vorhanden ist, wird's kritisch.

Set WsQ = WbQ.Worksheets(1)
ID = WsQ.Range(R_ID).Value

Hier lege ich fest, dass die w.o. bestimmte Zelle auf dem ersten (!) Blatt der Quell-Datei zu finden ist - Du hast ja nicht angegeben, ob es da evtl. mehrere Blätter gibt.

Set rSuch = .Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight))

Hier legst Du fest wo der (ich nenne ihn so) "ID-Wert", also der Wert jener Zelle der Quell-Datei, die Du w. o. definierst, gesucht wird. So wie es von mir geschrieben ist gehe ich davon aus, dass im Zielblatt die zu durchsuchenden Werte in Zeile 1 ab A1 stehen, und zwar lückenlos (!) - wenn dazwischen Leerzellen vorkommen können, müsste das so lauten

Set rSuch = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))

Dann noch

With WsQ
.Range("E5:E" & .Cells(.Rows.Count, 3).End(xlUp).Row).Copy
End With

Hier legst Du fest welcher Bereich des Quell-Tabellenblattes kopiert wird. Aber Achtung: So wie es jetzt dasteht heißt das, dass Du den Bereich E5:Ex kopierst, wobei sich aber das "x" aus der letzten gefüllten Zelle der Spalte C (= Spalte 3) bildet. Du willst aber vermutlich das Spaltenende von E, d.h. Du müsstest hier auch anpassen:

With WsQ
.Range("E5:E" & .Cells(.Rows.Count, 5).End(xlUp).Row).Copy
End With

...denn E = Spalte 5.
Und natürlich sorgt noch diese Zeile:

If Not IsError(Sp) Then

dafür, dass überhaupt nichts kopiert wird, wenn eine "ID" (also der Zell-Wert aus C1, wie im Bsp, oder E2 wie jetzt in Deiner Antwort) nicht in dem w.o. definierten Bereich gefunden wird.
Das also aufdröseln vermagst nur Du, weil Du Deine Dateien/Tabellen kennst.
LG
Michael

AW: Naja, das kommt eben darauf an...

08.09.2016 15:32:27

Marsl

Hi,
danke für die schöne Erklärung. Ich hatte vorher vergessen die Cells anzupassen ich Ochse.
Hier nochmal das ganze wies jetzt gerade steht, habe die Übersicht nochmal etwas umgebaut, daher sieht das ganze so aus:

Sub SpaltenHolen()
Const R_ID$ = "E2"
Const PFAD$ = "M:\August\"
Dim WbZ As Workbook
Dim WsZ As Worksheet
Dim WbQ As Workbook
Dim WsQ As Worksheet
Dim rSuch As Range
Dim Datei$, Sp, ID
Application.ScreenUpdating = False
Set WbZ = ThisWorkbook
Set WsZ = WbZ.Worksheets(1)
Datei = Dir(PFAD)
If Len(Datei) = 0 Then
MsgBox "Keine Dateieien gefunden in: " & PFAD, vbInformation, "Hinweis"
Exit Sub
End If
Do While Len(Datei) > 0
Set WbQ = Workbooks.Open(PFAD & Datei)
Set WsQ = WbQ.Worksheets(1)
ID = WsQ.Range(R_ID).Value
With WsZ
Set rSuch = .Range(.Cells(4, 6), .Cells(4, .Columns.Count).End(xlToLeft))
Sp = Application.Match(ID, rSuch, 0)
If Not IsError(Sp) Then
With WsQ
.Range("E5:E" & .Cells(.Rows.Count, 5).End(xlUp).Row).Copy
End With
.Cells(8, Sp).PasteSpecial xlPasteValuesAndNumberFormats
End If
End With
WbQ.Close False
Datei = Dir
Loop
Application.ScreenUpdating = True
Set WbZ = Nothing
Set WsZ = Nothing
Set WbQ = Nothing
Set WsQ = Nothing
Set rSuch = Nothing
End Sub

Meine Referenzen in der Übersicht stehen von F4-xn4
meine Referenzen in den Quelldateien stehen immer in E2 Bereich der kopiert werden soll steht in E5:Exn.
In F8:Fxn bis xn8:xnxn sollen meine ganzen Daten kopiert werden.
Jetzt habe ich noch das Problem, dass mir das Makro einige Daten (keine Ahnung welche) in der Zieldatei in Spalte D schreibt, obwohl er ja erst ab Spalte F anfangen soll :-/

AW: Naja, das kommt eben darauf an...

08.09.2016 15:39:17

Marsl

Grade gemerkt, dass die Zahlen auch nicht wirklich stimmen. Also was in der Zieldatei 123 steht wird nicht korrekt in die Quelldatei Spalte 123 übernommen, sondern irgendetwas anderes :-/

Und deshalb wollen wir immer Bsp-Dateien...

08.09.2016 15:52:46

Michael

Mein lieber Marsl,
...damit gleich klar ist, was es wie zu lösen gilt, und wir nicht in Codes wie In F8:Fxn bis xn8:xnxn miteinander kommunizieren müssen. So ist das nämlich Käse, und deshalb
Jetzt habe ich noch das Problem, dass mir das Makro einige Daten (keine Ahnung welche) in der Zieldatei in Spalte D schreibt, obwohl er ja erst ab Spalte F anfangen soll :-/
Klar, weil Du meine Annahmen nicht gelesen hast. Wenn Du erst in Spalte F startest, dann musst Du zu dem Wert von Sp noch einen entsprechenden Startwert hinzuaddieren. Warum? Mit dieser Zeile

Sp = Application.Match(ID, rSuch, 0)

erhältst Du die Position (!) des gesuchten Werts in einem Bereich, sofern er gefunden wird. Angenommen dieser Bereich geht von F4:H4 und der gesuchte Wert steht in G4; dann liefert Dir die o.a. Zeile den Wert "2" für Sp; weil G4 die zweite Zelle (Position) in diesem Bereich ist. Die Spaltenzahl von H4 ist aber "7". D.h. zum Wert von Sp musst Du prinzipiell "5" aufschlagen, weil Du die Spalten A-E (also 5) nicht mitzählst.
Der Code jetzt nochmal, auf Basis Deiner letzten Infos:

Sub SpaltenHolen()
Const R_ID$ = "E2"
Const PFAD$ = "U:\Test\"
Dim WbZ As Workbook
Dim WsZ As Worksheet
Dim WbQ As Workbook
Dim WsQ As Worksheet
Dim rSuch As Range
Dim Datei$, Sp, ID
Application.ScreenUpdating = False
Set WbZ = ThisWorkbook
Set WsZ = WbZ.Worksheets(1)
Datei = Dir(PFAD)
If Len(Datei) = 0 Then
MsgBox "Keine Dateieien gefunden in: " & PFAD, vbInformation, "Hinweis"
Exit Sub
End If
Do While Len(Datei) > 0
Set WbQ = Workbooks.Open(PFAD & Datei)
Set WsQ = WbQ.Worksheets(1)
ID = WsQ.Range(R_ID).Value
With WsZ
Set rSuch = .Range(.Cells(4, 6), .Cells(4, .Columns.Count).End(xlToLeft))
Sp = Application.Match(ID, rSuch, 0)
If Not IsError(Sp) Then
With WsQ
.Range("E5:E" & .Cells(.Rows.Count, 5).End(xlUp).Row).Copy
End With
.Cells(8, Sp + 5).PasteSpecial xlPasteValuesAndNumberFormats
End If
End With
WbQ.Close False
Datei = Dir
Loop
Application.ScreenUpdating = True
Set WbZ = Nothing
Set WsZ = Nothing
Set WbQ = Nothing
Set WsQ = Nothing
Set rSuch = Nothing
End Sub

LG
Michael

AW: Und deshalb wollen wir immer Bsp-Dateien...

08.09.2016 16:07:54

Marsl

Sorry wegen meinen Codes xD
Funktioniert jetzt super :)
Ich glaub ich hab auch verstanden , dass ich nen +5 setzen muss, wenn ich erst 5 Spalten weiter anfangen will :-/
Herzlichen Dank nochmal, auch für die gute Erklärung!

Gern, Danke für die Rückmeldung! Viel Erfolg owT

08.09.2016 16:17:11

Michael

Beliebteste Forumthreads (12 Monate)

Spez Nummer aus Datei in spez Spalte zuordnen VBA

Forumthread: Spez Nummer aus Datei in spez Spalte zuordnen VBA

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Spez Nummer aus Datei in spez Spalte zuordnen VBA

Forumthread: Spez Nummer aus Datei in spez Spalte zuordnen VBA

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread