Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  Zellen aus unterschiedlichen XLS-Files in eine Neue Tabelle kopieren (automatisch)

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Zellen aus unterschiedlichen XLS-Files in eine Neue Tabelle kopieren (automatisch) (796 mal gelesen)
thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 28. Nov. 2009 17:07    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Excel-Profis,

ich habe untenstehendess Makro für einen spez. Anwendungsfall und möchte diesen mit eurer Hilfe noch etwas verbessern

Vorgehensweise:
Es werden alle Files vom Server auf die lokale Platte bewegt. Danach öffnet sich eine Abfrage und ich muss die Files aus dem Verz.C:\test1 auswählen. Anschl. werden aus den Files die Zellen C10-J inkl. weitere Zeilen in meine aktuelle Mappe kopiert.

Frage1: Was muss ich machen um das auswählen des Verz im Browser und das selektieren der Files zu umgehen?
Frage2: Wie muss ich das Makro gestalten damit beim öffnen der XLS-Datei dieser komplette Vorgang automatisch gestartet wird?


Beispielmakro:

Sub test03()
Dim LetzteZeile As Integer
Dim nr As Integer


Dim objFSO As Object, objFile As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objFile In objFSO.GetFolder("\\server-99\test1\").Files
        objFile.Move "C:\test1\"
    Next
WBa = ActiveWorkbook.Name
GetMappe = Application.GetOpenFilename("xls-Dateien (*.xls),*.xls", , "bitte die xls-Dateien auswählen!", MultiSelect:=True)
For nr = LBound(GetMappe) To UBound(GetMappe)
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Workbooks.Open Filename:=GetMappe(nr)
    WBd = ActiveWorkbook.Name
Set cpy = Range("C10:F" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)
    Workbooks(WBa).Activate
        cpy.Copy Destination:=Worksheets("Tabelle1").Cells(LetzteZeile + 1, 2)
    Workbooks(WBd).Close SaveChanges:=False
Next nr

Habt Ihr einen Verbesserungsvorschlag?

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2897
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 28. Nov. 2009 17:48    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Code:
Sub test03()
Dim LetzteZeile As Integer
Dim nr As Integer

Dim objFSO As Object, objFile As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objFile In objFSO.getfolder("\\server-99\test1\").Files
        objFile.Move "C:\test1\"
    Next
WBa = ActiveWorkbook.Name

Set fso = CreateObject("Scripting.FileSystemObject")
Pfad = "C:\test1\" 'auswahlverzeichnis
Set fo = fso.getfolder(Pfad)

For Each file In fo.Files
    If Right(file.Name, 3) = "xls" Then
    LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row  'ermitteln der letzten Zeile des aktiven Arbeitsblattes
    Workbooks.Open Filename:=file
    WBd = ActiveWorkbook.Name
    Set cpy = Range("C10:F" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)
        Workbooks(WBa).Activate
            cpy.Copy Destination:=Worksheets("Tabelle1").Cells(LetzteZeile + 1, 2)
        Workbooks(WBd).Close SaveChanges:=False
    End If
End Sub
Next


zum Automatisieren, gebe in deiner Arbeitsmappe
Code:
Sub Workbook_Open()
Call deinMakro 'test03
End Sub
ein

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 28. Nov. 2009 19:12    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Thomas,

das mit dem Makro funktioniert so nicht bei mir.
Ich sehe das die 4 Files der Reihe nach importiert werden, aber wenn das Makro durchgelaufen ist, bleibt im Tabellenblatt nur der Zeileninhalt des letzten Files.

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Thomas Harmening
Moderator
Arbeiter ツ




Sehen Sie sich das Profil von Thomas Harmening an!   Senden Sie eine Private Message an Thomas Harmening  Schreiben Sie einen Gästebucheintrag für Thomas Harmening

Beiträge: 2897
Registriert: 06.07.2001

Das Innerste geäussert
und aufs Äusserste verinnerlicht

erstellt am: 28. Nov. 2009 19:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für thewolff 10 Unities + Antwort hilfreich

Code:
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ist bei meiner Kopieraktion verlorengegangen ;-)...
das muss natürlich wieder an die richtige Stelle
vor
Code:
Workbooks.Open Filename:=file

nach dem schliessen von Workbooks(WBd) sollte ja nur Workbooks(WBa) aktiv sein.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP



Promotion im Bereich Fahrwerk Vorentwicklung Bremse ab Mai 2024
Life is always about becoming? Im Leben geht es darum, sich auf eine Reise zu begeben, um die beste Version unseres zukünftigen Selbst zu werden. Während wir Neues entdecken, stellen wir uns Herausforderungen, meistern sie und wachsen über uns hinaus.

Bewerben Sie sich bei Mercedes-Benz und finden Sie den Aufgabenbereich, in dem Sie Ihre Talente individuell entfalten können. Dabei werden Sie von visionären Kolleginnen und Kollegen unterstützt, die Ihren Pioniergeist teilen....
Anzeige ansehenFahrzeugtechnik
thewolff
Mitglied



Sehen Sie sich das Profil von thewolff an!   Senden Sie eine Private Message an thewolff  Schreiben Sie einen Gästebucheintrag für thewolff

Beiträge: 140
Registriert: 03.06.2003

erstellt am: 28. Nov. 2009 19:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Super, jetzt klapperts auch!
So ist die Lösung TOP.

Vielen Dank für die Superschnelle Lösung.

Schönes Wochenende.......

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz