Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Wie einzelne Zellen aus mehreren Excel-Dateien auslesen und in eine neue Datei einfügen?

Mitglied: ThiesK

ThiesK (Level 1) - Jetzt verbinden

27.07.2012, aktualisiert 11:30 Uhr, 12754 Aufrufe, 15 Kommentare

Hallo liebes Forum,

nach stundenlanger Suche im Internet und keiner wirklich gefundenen Lösung hoffe ich, dass hier mir jemand helfen kann.
Für die Arbeit soll ich aus vielen Excel-Dateien eine Auswertung vornehmen. Ich dachte mir am Besten per Makro/VBA. Da ich mich damit jedoch nicht so gut auskenne, hoffte ich ein bestehendes Programm umzuschreiben, was jedoch scheiterte..

Die einzelnen Excel-Dateien sehen so aus, dass immer aus der "Tabelle1" die Informationen aus den Zellen "B28", "E28", "H28", "O28", "Q28", "A30", "A31" ausgelesen und dann ab der 3.Zeile (Die ersten beiden Zeilen sollen für Überschriften da sein) spaltenweise eingefügt werden sollen. Also: Alle Werte von "B28" untereinander, alle Werte von "E28" untereinander, etc.

Für eure Unterstützung wäre ich euch sehr sehr dankbar!

Ich nutze Excel 2007 und Win XP. Falls ihr noch weitere Fragen habt, werde ich sie schnellstmöglichst beantworten!

Vielen Dank noch einmal!

Gruß ThiesK
Mitglied: Eierbaer
27.07.2012 um 14:27 Uhr
Hallo ThiesK,

probiers einmal hiermit, muss Du natürlich etwas anpassen, aber funktioniert:

01.
Option Explicit 
02.
 
03.
Public Sub ExcelDateienAuswerten() 
04.
 
05.
    Dim strDateiname As String 
06.
    Dim strPfad      As String 
07.
    Dim lngZeile     As Long 
08.
     
09.
    'Pfadangabe, in dem die zu lesenden Excel-Datei (*.xls) liegen 
10.
    strPfad = "F:\Projekte\Administrator.de\Quelle\" 
11.
     
12.
    'Den 1. Dateinamen holen 
13.
    strDateiname = Dir(strPfad & "*.xls") 
14.
 
15.
    'Startzeile festlegen 
16.
    lngZeile = 3 
17.
     
18.
    'Solange ein Dateiname gelesen wird 
19.
    Do While Not strDateiname = "" 
20.
         
21.
        'Datei verarbeiten 
22.
        Call TabVerarb(strPfad & strDateiname, lngZeile) 
23.
         
24.
        'nächsten Dateinamen holen 
25.
        strDateiname = Dir() 
26.
         
27.
        'Zeilenzähler erhöhen 
28.
        lngZeile = lngZeile + 1 
29.
     Loop 
30.
 
31.
End Sub 
32.
 
33.
 
34.
 
35.
Public Sub TabVerarb(strPfad As String, lngZeile As Long) 
36.
    Dim strMeSH As String 
37.
    Dim strDatei As String 
38.
    Dim strSH As String 
39.
     
40.
    'Dateinamen extrahieren 
41.
    strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\"))) 
42.
     
43.
    'Eigenen Namen merken 
44.
    strMeSH = ActiveWorkbook.Name 
45.
     
46.
    'Datei öffnen 
47.
    Workbooks.Open Filename:=strPfad 
48.
     
49.
    With Workbooks(strMeSH) 
50.
        'Dateinamen und auszuwertenden Zellen übertragen 
51.
        .Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei 
52.
        .Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Tabelle1").Range("B28").Value 
53.
        .Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Tabelle1").Range("E28").Value 
54.
        .Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Tabelle1").Range("H28").Value 
55.
        .Sheets("Tabelle1").Cells(lngZeile, 5) = Workbooks(strDatei).Sheets("Tabelle1").Range("O28").Value 
56.
        .Sheets("Tabelle1").Cells(lngZeile, 6) = Workbooks(strDatei).Sheets("Tabelle1").Range("Q28").Value 
57.
        .Sheets("Tabelle1").Cells(lngZeile, 7) = Workbooks(strDatei).Sheets("Tabelle1").Range("A30").Value 
58.
        .Sheets("Tabelle1").Cells(lngZeile, 8) = Workbooks(strDatei).Sheets("Tabelle1").Range("A31").Value 
59.
    End With 
60.
     
61.
    'Quelldatei schließen 
62.
    Workbooks(strDatei).Saved = True 
63.
    Workbooks(strDatei).Close 
64.
 
65.
End Sub 
66.
 

Gruß
Rüdiger aus Minden
Bitte warten ..
Mitglied: 76109
27.07.2012, aktualisiert um 16:39 Uhr
Hallo ThiesK!

Oder so:
01.
Option Explicit 
02.
 
03.
Const sXlsPath = "D:\Temp" 
04.
Const iStartZeile = 3 
05.
Const iStartSpalte = 1 
06.
 
07.
Const Zellen = "B28,E28,H28,O28,Q28,A30,A31" 
08.
 
09.
 
10.
Sub CopyExternData() 
11.
    Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet 
12.
    Dim aCells As Variant, iNextLine As Long, i As Integer 
13.
     
14.
    Set oWks0 = ThisWorkbook.ActiveSheet 
15.
     
16.
    aCells = Split(Zellen, ","):  iNextLine = iStartZeile 
17.
     
18.
    Set oFso = CreateObject("Scripting.FilesystemObject") 
19.
     
20.
    For Each oFile In oFso.GetFolder(sXlsPath).Files 
21.
        If LCase(oFso.GetExtensionName(oFile.Name)) = "xls" Then 
22.
            If ThisWorkbook.Name <> oFile.Name Then 
23.
                Set oWkb1 = Workbooks.Open(oFile.Path) 
24.
                Set oWks1 = oWkb1.Sheets(1) 
25.
                For i = 0 To UBound(aCells) 
26.
                    oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i) = oWks1.Range(Trim(aCells(i))).Value 
27.
                Next 
28.
                oWkb1.Close False 
29.
                iNextLine = iNextLine + 1 
30.
            End If 
31.
        End If 
32.
    Next 
33.
End Sub
Gruß Dieter

[edit] Hatte doch was übersehen (ThisWorkbook.Path anstatt .Name) [/edit]
Bitte warten ..
Mitglied: ThiesK
27.07.2012 um 15:16 Uhr
Hallo Rüdiger,

vielen vielen Dank für deine Mühe und verständnisvolle Kommentargebung im Programm. Du hast mir sehr geholfen, dass Programm arbeitet einwandfrei! Als gelernter Nutzer der "C"-Programmierung, konnte ich das Programm jetzt gut nachvollziehen und die Arbeitsweise verstehen! Zwischenzeitlich hatte ich mir aus vielen verschiedenen Programmteilen aus diesem Forum ein eigenes Programm geschrieben, dieses hatte jedoch etliche Bugs...

Also nochmal: Vielen Dank für deine Mühe. Ich hoffe auch andere Nutzer mit einem ähnlichen Problem können hieraus schöpfen

Grüße
Thies
Bitte warten ..
Mitglied: bastla
27.07.2012 um 15:31 Uhr
[OT] @Dieter
Irgendwie vermisse ich noch die "Union()"-Variante ..

Grüße
bastla
[/OT]
Bitte warten ..
Mitglied: ThiesK
27.07.2012 um 15:52 Uhr
Ja, ich habe diese Version auch noch einmal ausprobiert, aber da kommt das Programm in eine Endlosschleife... Trotzdem vielen Dank für die Mühe, Dieter, auch wenns noch nicht 100%ig hinhaut, weiß ich das zu schätzen!

Grüße
Thies
Bitte warten ..
Mitglied: 76109
27.07.2012, aktualisiert um 16:20 Uhr
[OT]
Hallo bastla!

Die hatte ich auch zuerst im Auge gehabt, aber das funktioniert in der Regel nur, wenn sich alle Werte in der gleichen Zeile befinden. Ansonsten geht's über Areas und da werden alle Werte die auseinanderliegen in ein Item und die Werte, die zusammen liegen (A30, A31) werden als Array in Item übernommen

Gruß Dieter
[/OT]
Bitte warten ..
Mitglied: 76109
27.07.2012, aktualisiert um 16:41 Uhr
Hallo Thies!

Endlosschleife, wie das?


Gruß Dieter


PS. Oben geändert: Von ThisWorkbook.Path nach ThisWorkbook.Name...
Bitte warten ..
Mitglied: beggagsell
05.02.2013 um 09:57 Uhr
Hallo zusammen,
ich bin neu im Bereich VB Programmierung und habe mir die Lösung hier angeschaut. Die trifft meine eigene Anforderung fast genau.

Meine Frage: Wie kann ich es hinterlegen, dass weitere Daten über eine Schleife wiederholdend aus einem Arbeitsblatt ausgelesen und die ausgelesenen Werte untereinander dargestellt werden?

B28,E28,H28,O28,Q28,A30,A31
B128,E128,H128,O128,Q128,A130,A131
B228,E228,H228,O228,Q228,A230,A231
..... (500 Auswertungen, die Zeilenabstände erhöhen sich jeweils um 100)


Liebe Grüße

Beggagsell
Bitte warten ..
Mitglied: 76109
23.02.2013, aktualisiert um 11:40 Uhr
Hallo Beggagsell!

Hatte leider wenig Zeit, von daher etwas verspätet in etwa so:
01.
Option Explicit 
02.
 
03.
Const sXlsPath = "D:\Temp" 
04.
Const iStartZeile = 3           'Diese Arbeitsmappe, Daten ab Zeile 
05.
Const iStartSpalte = 1          'Diese Arbeitsmappe, Daten ab Spalte 
06.
 
07.
Const iStartCopyZeile = 28      'Externe Arbeitsmappe,Daten ab Zeile (28) 
08.
Const iNextCopyZeile = 100      'Externe Arbeitsmappe,Daten nächste Zeile (+100) 
09.
 
10.
Sub CopyExternData2() 
11.
    Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet 
12.
    Dim aOfs As Variant, oNextCell As Range, iNextLine As Long, i As Integer 
13.
     
14.
    Set oWks0 = ThisWorkbook.ActiveSheet 
15.
    Set oFso = CreateObject("Scripting.FilesystemObject") 
16.
     
17.
    'Relative Offset-Adressen (Aktuelle Zeile + ?, Spalte 1 + ?) 
18.
    'Bei aktueller Zeile 28 entspricht dies: B28, E28, H28, O28, Q28, A30, A31 
19.
    aOfs = Array(Array(0, 1), _ 
20.
                 Array(0, 4), _ 
21.
                 Array(0, 7), _ 
22.
                 Array(0, 14), _ 
23.
                 Array(0, 16), _ 
24.
                 Array(2, 0), _ 
25.
                 Array(2, 0)) 
26.
     
27.
    iNextLine = iStartZeile 
28.
     
29.
    Application.ScreenUpdating = False 
30.
     
31.
    For Each oFile In oFso.GetFolder(sXlsPath).Files 
32.
        If LCase(oFso.GetExtensionName(oFile.Name)) = "xls" Then 
33.
            If ThisWorkbook.Name <> oFile.Name Then 
34.
                Set oWkb1 = Workbooks.Open(oFile.Path) 
35.
                Set oWks1 = oWkb1.Sheets(1) 
36.
                 
37.
                'Set Bezugs-Zelle (Bei Zeile 28: A28) 
38.
                Set oNextCell = oWks1.Cells(iStartCopyZeile, "A") 
39.
                 
40.
                'Daten kopieren, solange Zelle (B28, B128, ...) mit Inhalt 
41.
                Do While oNextCell.Offset(aOfs(0)(0), aOfs(0)(1)).Text <> "" 
42.
                    For i = 0 To UBound(aOfs) 
43.
                        oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i).Value = oNextCell.Offset(aOfs(i)(0), aOfs(i)(1)).Value        
44.
                    Next 
45.
                     
46.
                    'Set Next Bezugs-Zelle + 100 Zeilen (A128, A228, ...) 
47.
                    Set oNextCell = oNextCell.Offset(iNextCopyZeile, 0):  iNextLine = iNextLine + 1 
48.
                Loop 
49.
                oWkb1.Close False 
50.
            End If 
51.
        End If 
52.
    Next 
53.
    Application.ScreenUpdating = True 
54.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: beggagsell
26.02.2013 um 13:50 Uhr
Hallo Dieter,

Danke für die Information.
Leider funktioniert das Makro nicht.
Es wird zwar die Datei in c:\temp geöffnet, aber kein Wert in die Zieltabelle geschrieben.
Die einzige Änderung die ich vornehme ist die Umstellung auf c:\temp
Könntest du noch mal drüberschauen - wäre echt super.

Danke

Beggagsell
Bitte warten ..
Mitglied: 76109
27.02.2013, aktualisiert um 00:18 Uhr
Hallo Beggagsell!

Sorry, bei mir funktionierts?

Befinden sich die Daten im ersten Tabellenblatt und stimmen die Basis-Zellen (B28, E28, H28, O28, Q28, A30, A31) überein. Ausserdem dürfen die Bezugszellen (B28, B128, B...) nicht leer sein...

Gruß Dieter
Bitte warten ..
Mitglied: beggagsell
27.02.2013 um 15:41 Uhr
Hallo Dieter,
so ist das nun mal...
Wenn man die Datei nicht mit der Endung xlsx speichert, klappt das besser. (geöffnet wurde eine andere Datei im Verzeichnis ohne Daten in den jeweiligen Feldern)

Du hast mir mehrere Stunden mit meiner Freundin verschafft, die ich sonst am PC verbracht hätte.

Herzlichen Dank - eine Top Lösung.
Bitte warten ..
Mitglied: HC-Ahnungslos
18.12.2015, aktualisiert um 19:20 Uhr
Einen schönen guten Tag Rüdiger,
ich habe dein Codefragment (erste Lösung) gefunden und nach der Beschreibung passt es perfekt auf meine Bedürfnisse. Leider bin ich ein VBA Laie und kriege es nicht ganz zum laufen. Ich kriege immer den gleichen Fehler 68. in Zeile 13 bei Dir. ich nutze Excel auf dem Mac, könnte es daran liegen? grundsätzlich habe ich eigentlich nur das .xls in .xlsx geändert da ich mit eben diesen Dateien arbeite.

Für einen Tipp wäre ich wirklich sehr dankbar!
Einen schönen Abend noch

Gruß
HC
Bitte warten ..
Mitglied: pplifr
23.08.2017 um 16:54 Uhr
Hallo@all,

habe die Lösung von Dieter jetzt adaptiert und funktioniert fast so genau so wie ich will.
Habe aber sehr viele Files welche ich wöchentlich auslesen muss.
Das Makro öffnet ja jedes File.
Das dauert leider zu lange. In dem Ordner befinden sich Prüfprotokolle vom ganzen Jahr (1000+)
Ich muss aus Prüfprotokollen immer 12 idente Zellen auslesen, welche wir dann gelistet in Power BI auswerten.
Prüfprotokoll kann ich leider nicht anpassen, somit brauche ich diesen Zwischenschritt über ein auswertbares File.

*
Const sXlsPath = "G:\QUALITÄTSSICHERUNG\AUSW_TEST"
Const iStartZeile = 5
Const iStartSpalte = 1
Const Zellen = "F1,E3,E8,E9,E10,E11,I8,I9,I10,I11,I12,I13"
***
Bin leider ein absoluter DAU bei Excel und speziell bei VBA.

Vielleicht kann mir ja wer helfen

Danke vorab

Markus
Bitte warten ..
Mitglied: Aston01
24.10.2017 um 11:51 Uhr
Hallo
Ich bekomme täglich 50 Mails mit je einer xlsx Datei. Diese heissen immer gleich und zwar order.xlsx. Nun möchte mit einem Makro alle xlsx Files durchgehen die in einem bestimmten Ordner sind und überprüfen, ob das Datum in der Zelle … z.B 24-10-2017 mit dem Namen eines erstellten xlsx. file übereinstimmt, welches den Namen z.B UC -Rondo-Safe-(hier kommt dann ein Datum rein) hat. Wenn dies zutrifft, sollen nun die ganzen Werte aus dieser Datei in die erstellte Datei eingefügt werden.
Ich hoffe das mir jemand bei diesem Problem helfen kann, weil ich verzweifelt nach einer Lösung suche.
LG
Bitte warten ..
Ähnliche Inhalte
Microsoft Office

Excel Dateien durchsuchen und Werte einzeln in neue Excel Datei auslesen

Frage von krischaniiMicrosoft Office1 Kommentar

Hallo und Danke für Eure stets guten Antworten und Hilfen! Folgendes Problem habe ich: Win 8.1 - Office2013 Ich ...

Batch & Shell

Aus mehreren Excel-Dateien Daten auslesen und in eine Excel Datei einfügen - Batch

gelöst Frage von LegolegolasBatch & Shell7 Kommentare

Nachdem mir hier schon einmal geholfen wurde, möchte ich erneut um Eure Hilfe für einen Batch bieten. Folgendes Szenario: ...

Microsoft Office

Excel Dateien durchsuchen und mehrere Werte in neue Excel Datei auslesen

Frage von CollatusMicrosoft Office7 Kommentare

Hallo zusammen, im Forum bin ich schon auf einen guten Ansatz gestoßen der mir schon sehr weiter Hilft aber ...

Microsoft Office

VBA Excel Mehrere Dateien auslesen

Frage von abuelitoMicrosoft Office7 Kommentare

Hallo an Alle, ich habe folgendes Problem: Ich habe einen Ordner, in diesem befinden sich mehrere xls-Dateien (ca. 2.000) ...

Neue Wissensbeiträge
Windows 10

USB Maus und Tastatur versagen Dienst unter Windows 10

Erfahrungsbericht von hardykopff vor 2 TagenWindows 105 Kommentare

Da steht man ziemlich dumm da, wenn der PC sich wegen fehlender USB Tastatur und Maus nicht bedienen lässt. ...

Administrator.de Feedback
Update der Seite: Alles zentriert
Information von Frank vor 2 TagenAdministrator.de Feedback18 Kommentare

Hallo User, die größte Änderung von Release 5.8 ist das Zentrieren der Webseite (auf großen Bildschirmen) und ein "Welcome"-Teaser ...

Humor (lol)

WhatsApp-Nachrichten endlich auch per Bluetooth versendbar

Information von BassFishFox vor 3 TagenHumor (lol)4 Kommentare

Genau darauf habe ich gewartet! ;-) Der beliebte Messaging-Dienst WhatsApp erhält eine praktische neue Funktion: Ab dem nächsten Update ...

Google Android

Googles "Android Enterprise Recommended" für Unternehmen

Information von kgborn vor 3 TagenGoogle Android3 Kommentare

Hier eine Information, die für Administratoren und Verantwortliche in Unternehmen, die für die Beschaffung und das Rollout von Android-Geräten ...

Heiß diskutierte Inhalte
Router & Routing
Router auf Orginal Firmware zurück flashen mit Tftpd
Frage von ILeonardRouter & Routing21 Kommentare

Hallo, Ich habe zwei Router, einmal TP-Link 841n v11 und TP-Link 940N v5. Ich wollte fragen, ob jemand mir ...

Router & Routing
WRT keine Verbindung zum Web Interface
gelöst Frage von ILeonardRouter & Routing18 Kommentare

Hallo, Ich habe einen TP-Link WR841n mit wrt geflasht, das Problem ist ich kann mich mit 192.168.1.1 nicht verbinden. ...

Windows Server
Standortvernetzung zu einem Strato VServer (Windows)
Frage von matzefratze81Windows Server10 Kommentare

Moin, ich komme aus einem Enterprise-Umfeld und habe den Fehler gemacht, dass ich mich auf ein kleines Unternehmen eingelassen ...

TK-Netze & Geräte
Telefonie zweier Fritzboxen mit je eigenem DSL Anschluss verbinden
Frage von hannsgmaulwurfTK-Netze & Geräte10 Kommentare

Hallo zusammen, ich habe hier einen Haushalt mit zwei Anschlüssen. Einmal ISDN, einmal DSL. An jedem Anschluss hängt eine ...