Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
752to756
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
752to756
752to756
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateneinspielung per Makro in 600 Dateien

Dateneinspielung per Makro in 600 Dateien
14.04.2006 16:34:26
Elmar
Hallo,
ich hoffe, einer von Euch Excel-Profis hier kann mir vielleicht weiterhelfen. Im Rahmen einer Studienarbeit muss ich Daten entsprechend einer Liste in ca. 600 Dateien einspielen. Eventuell lässt sich das per Makro erledigen aber ich habe bisher leider erfolglos im Internet nach einem Makro dieser Art gesucht. Ich bin zwar mit Excel einigermaßen fit, aber was die Erstellung von Makros angeht, bin ich noch ein Greenhorn. Es reicht gerade so für kleinere Anpassungen :-(
So, nun mein Problem in vereinfachter Form:
Ich habe eine Quelldatei (Link siehe unten)in der in der zweiten Spalte eine Projektnummer (111, 112, 113...)steht.
In der ersten Spalte steht eine regionale Angabe (Nord, Süd, Ost) wo das Projekt stattfindet.
In der dritten Spalte ist ein Wert angegeben. Dieser Wert soll jeweils in eine Zieldatei mit Namen „BP_111“, „BP_112“, „BP_113“ usw. eingespielt werden und zwar jeweils auf das gleiche Tabellenblatt „IH“ immer in die Zellen B1 bis B15; D1 bis D15 und F1 bis F15. In den Zieldateien soll also dann in den 3x15 Zellen immer der gleiche Wert stehen. Die Zieldateien liegen entsprechend ihrer regionalen Zuordnung in einem Ordner „Nord“, Süd“ oder „Ost“
Hat jemand von Euch eine einfache Idee für dieses Problem oder ein ähnliches Makro vorliegen, was einfach umzubauen wäre?
Vielen Dank im Voraus für alle Tipps!
Elmar
Quelldatei: https://www.herber.de/bbs/user/32887.xls

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateneinspielung per Makro in 600 Dateien
15.04.2006 01:09:42
Franz
Hallo Elmar,
habe folgendes Makro gebastelt.

Sub DatenTransferieren()
Dim Daten As Range, wbZiel As Workbook, wksZiel As Worksheet
Dim Pfad As String, Datei As String, I As Integer
With ActiveWorkbook.Sheets("Tabelle1")
Set Daten = .Range(Cells(2, 1), Cells(.UsedRange.Rows.Count, 3)) 'Ursprungsdaten
End With
Application.ScreenUpdating = False
' Daten übertragen
For I = 1 To Daten.Rows.Count
On Error GoTo Fehler 'fängt nicht vorhandene Datei ab
Pfad = "C:\Test\" & Daten(I, 1) ' Pfad anpassen !
Datei = "BP_" & Daten(I, 2) & ".xls"
Application.StatusBar = "Datei " & Pfad & "\" & Datei & " wird bearbeitet"
Workbooks.Open (Pfad & "\" & Datei)
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Sheets("IH")
wksZiel.Range("B1:B15").Value = Daten(I, 3)
wksZiel.Range("D1:D15").Value = Daten(I, 3)
wksZiel.Range("F1:F15").Value = Daten(I, 3)
wbZiel.Save
wbZiel.Close False
GoTo NextFile
Fehler:
MsgBox ("Datei " & Pfad & "\" & Datei & " nicht gefunden")
NextFile:
Next I
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

Gruß
Franz
Anzeige
AW: Dateneinspielung per Makro in 600 Dateien
15.04.2006 11:26:03
Elmar
Hallo Franz,
vielen Dank für Deine Hilfe! Ich hätte nicht gedacht, dass ich so schnell Antwort bekomme. Ich werde Dein Makro heute testen und gebe auf jeden Fall noch Bescheid ob es geklappt hat. Dir schonmal ein schönes Osterfest!
Gruß und nochmal vielen Dank,
Elmar
AW: Dateneinspielung per Makro in 600 Dateien
15.04.2006 04:00:49
Heinz
Hallo Elmar
Hier Selbstgestricktes, das hinhauen müsste
Wollte aber nicht auf die Tabelleneinträge losgehen, ehe nicht geprüft wird, ob allsamt zur Verfügung steht. Darum der Makroaufruf über 'DateienprüfenUndDannSchreiben'.
Damit wird im Vorfeld bereits geprüft und das Programm im Fehlerfall abgebrochen (inkl. Fehlermeldung in welcher Zeile), sollte eine Datei im falschen Ordner abgelegt sein oder garnicht existieren. Sollte alles passen übergibt die Prüfung dann an
'DatenInTabellenSchreiben' und füllt dir die Dateien wunschgemäß.
Ansonst wünsch' ich Dir Frohe Ostern und mir ev. Rückantwort

Sub DateienprüfenUndDannSchreiben()
Dim strPath, strFolder, strFName
Dim strDir
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path & "\"
Set a = Range("A2")
Do While Not IsEmpty(a)
Set b = a.Offset(1, 0)
strFolder = a.Value & "\"
strFName = "BP_" & a.Offset(0, 1) & ".xls"
strDir = Dir(strPath & strFolder & strFName)
If strDir = "" Then
MsgBox "Fehler in Zeile: " & a.Row & Chr(10) _
& strPath & strFolder & strFName & " nicht gefunden"
Application.ScreenUpdating = True
Exit Sub
End If
Set a = b
Loop
DatenInTabellenSchreiben strPath, strFolder, strFName
Application.ScreenUpdating = True
End Sub


Sub DatenInTabellenSchreiben(strPath, strFolder, strFName)
Dim strWsName, strValue
Dim rng1, rng2, rng3 As Range
strWsName = "IH"
Set a = Range("A2")
Do While Not IsEmpty(a)
Set b = a.Offset(1, 0)
strFolder = a.Value & "\"
strFName = "BP_" & a.Offset(0, 1) & ".xls"
strValue = a.Offset(0, 2).Text
Workbooks.Open (strPath & strFolder & strFName)
Set rng1 = Worksheets(strWsName).Range("B1:B15")
Set rng2 = Worksheets(strWsName).Range("D1:D15")
Set rng3 = Worksheets(strWsName).Range("F1:F15")
For Each zelle In rng1
zelle.Value = strValue
Next
For Each zelle In rng2
zelle.Value = strValue
Next
For Each zelle In rng3
zelle.Value = strValue
Next
ActiveWorkbook.Save
ActiveWorkbook.Close
Set a = b
Loop
End Sub

Anzeige
AW: Dateneinspielung per Makro in 600 Dateien
15.04.2006 11:30:53
Elmar
Hallo Heinz,
Dir herzlichen Dank für die Unterstützung über Nacht! Ich hoffe, Du hast trotzdem noch etwas Schlaf gekriegt! Ich probier Deine Lösung heute noch gleich aus und bin schon sehr gespannt..Da ich jetzt 2 Lösungen bekommen habe, bin ich sogar doppelt abgesichert, werde aber beide testen und Dir dann auch mitteilen, ob es geklappt hat.
Nochmals vielen Dank und Dir ein schönes Osterfest!
Gruß,
Elmar

6 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige