Supportnet / Forum / Tabellenkalkulation
need Excelmakro
Frage
Hallo !
Aus einem leeren Tabellenblatt möchte ich ein Makro starten. Und damit soll eine Ordner inklusive aller Unterordner nach allen Dateien durchsucht werden die mit BP anfangen und die Erweiterung xls tragen. (z.B BP123456-78901.xls). Aus allen gefundenene Dateien soll dann der Inhalt der Zellen C12, C15, C26, C28, C30, C32 und A1 in das leere Tabellenblatt kopiert werden. Und zwar in folgender Anordnung:
SpalteA Dateiname
SpalteB C12
SpalteC C15
SpalteD C26
SpalteE C28
SpalteF C30
SpalteG C32
SpalteH A1
(natürlich quer) ;-)
Ich hoffe ihr könnt mir helfen. Mein VBA reicht dafür leider nicht aus und ich brauch es dringend.
Danke
Nico
Antwort 1 von Saarbauer
Hallo,
vom Grundsatz her zu machen, aber mit Unterordner hab ich es noch nicht versucht
Hier ein ähnliches Problem
https://supportnet.de/threads/1393293
mit VBA gelöst, hielft vielleicht weiter, sonst weitere Einzelheiten oder Beispiel hier einstellen
http://www.netupload.de/
und Link hier hinterlegen
Gruß
Helmut
vom Grundsatz her zu machen, aber mit Unterordner hab ich es noch nicht versucht
Hier ein ähnliches Problem
https://supportnet.de/threads/1393293
mit VBA gelöst, hielft vielleicht weiter, sonst weitere Einzelheiten oder Beispiel hier einstellen
http://www.netupload.de/
und Link hier hinterlegen
Gruß
Helmut
Antwort 2 von nighty
hi all :)
wie gewünscht :))
gruss nighty
Option Explicit
Sub makro01()
Dim Dateien As Integer
Dim zeilen(7) As Integer
Dim zaehler As Integer
zeilen(2) = 12
zeilen(3) = 15
zeilen(4) = 26
zeilen(5) = 28
zeilen(6) = 30
zeilen(7) = 32
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp\"
.SearchSubFolders = True
.Filename = "BP*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Dateien)
Workbooks(1).Sheets(1).Cells(Dateien, 1) = .FoundFiles(Dateien)
For zaehler = 2 To 7
Workbooks(1).Sheets(1).Cells(Dateien, zaehler) = Workbooks(2).Sheets(1).Cells(zeilen(zaehler), 3)
Next zaehler
Workbooks(1).Sheets(1).Cells(Dateien, 8) = Workbooks(2).Sheets(1).Cells(1, 1)
Workbooks(2).Close
Next Dateien
End If
Application.DisplayAlerts = True
End With
End Sub
wie gewünscht :))
gruss nighty
Option Explicit
Sub makro01()
Dim Dateien As Integer
Dim zeilen(7) As Integer
Dim zaehler As Integer
zeilen(2) = 12
zeilen(3) = 15
zeilen(4) = 26
zeilen(5) = 28
zeilen(6) = 30
zeilen(7) = 32
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp\"
.SearchSubFolders = True
.Filename = "BP*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(Dateien)
Workbooks(1).Sheets(1).Cells(Dateien, 1) = .FoundFiles(Dateien)
For zaehler = 2 To 7
Workbooks(1).Sheets(1).Cells(Dateien, zaehler) = Workbooks(2).Sheets(1).Cells(zeilen(zaehler), 3)
Next zaehler
Workbooks(1).Sheets(1).Cells(Dateien, 8) = Workbooks(2).Sheets(1).Cells(1, 1)
Workbooks(2).Close
Next Dateien
End If
Application.DisplayAlerts = True
End With
End Sub
Antwort 3 von nighty
hi all :)
netupload ist nicht so anzuraten,weil fuer andere user mit der suchfunktion nichts mehr nachvollziehbar ist da netupload es nur auf zeit haellt.
gruss nighty
netupload ist nicht so anzuraten,weil fuer andere user mit der suchfunktion nichts mehr nachvollziehbar ist da netupload es nur auf zeit haellt.
gruss nighty
Antwort 4 von nighty
hi all :)
zudem die beschreibung eindeutig und perfekt ist :))
gruss nighty
zudem die beschreibung eindeutig und perfekt ist :))
gruss nighty
Antwort 5 von Excelcookie
@nighty
PERFEKT!!! :-)
Danke vielmals
Nico
PERFEKT!!! :-)
Danke vielmals
Nico