01.03.2012, aktualisiert am 18.10.2012

8053

Ein Makro in Visual Basic für Excel erstellen

Es handelt sich um 250 verschiedene .xlsx, und aus jedem sollen 5 Werte ausgelesen werden und in eine Extra - Datei eingefügt werden. Der Aufbau aller Blätter ist ident.

Hallo und guten Tag =)

Ich hätte da mal wieder eine Frage an euch. Meine VisualBasic Kentnisse sind, wie soll ich sagen, schlecht bis gar nicht vorhanden.

Es geht um folgendes:
Es gibt 250 verschiedene Excel-Dateien. Diese sind von der Feldzuordnung her ident, weil diese Dateien von einer Maschine automatisch erzeugt werden. Aus diesen Excel-Dateien, welche jeweils immer nur 1 Tabelle beinhaltet (Tabelle 1), sollen jetzt 5 Werte in eine andere, neue Excel-Datei geschrieben werden.

Ich habe bereits alle Excel – Dateien markiert und mittels F2 in Right (1), Right (2) …. Right (250) umbenannt.
Den Wert wollte ich mir ursprünglich direkt herholen und irgendeine Möglichkeit finden die Zahl in der Klammer zu ändern:

=('[Right (1).xls]Tabelle1'!$R$10)

Egal wie ichs versuche, es funktioniert nicht, ganz klar, wir brauchen ein Makro.

Meine letzte Lösung wäre das mittels eines Makros abzuwickeln, per Visual Basic. Ich kenne mich mit Visual Basic aber leider nicht aus.

Könnt ihr mir bitte helfen? Wenn man es kann ist es sicher Watschneinfach und nur ein script das über vlt 10 Zeilen geht?

Ich will die jeweils 5 Werte aus den Zellen (die sind ja bei allen 250 Blättern gleich):

Wert Wert Wert Wert Wert Wert
R10 F9 U28 M28 E28 M29
R10 F9 U28 M28 E28 M29
R10 F9 U28 M28 E28 M29
R10 F9 U28 M28 E28 M29

In ein Arbeitsblatt einfügen lassen, und dass für alle 250 Arbeitsblätter und ich möchte nicht 250 mal von Hand 5 Werte aus/einlesen.
Es handelt sich um Excel 2010

Ich bedanke mich jetzt schon recht herzlich und hoffe auf Hilfe.

Lg Alex

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 181276

Url: https://administrator.de/forum/ein-makro-in-visual-basic-fuer-excel-erstellen-181276.html

Ausgedruckt am: 23.12.2024 um 08:12 Uhr

38 Kommentare

Neuester Kommentar

Hallo Alex-IT02!

Weil der zuletzt erst wieder ausgegraben worden war: Schau mal, ob in diesem Beitrag etwas für Dich dabei ist ...

Grüße
bastla

Hallo Bastla =)

jetzt is mir schwindlig xD
Soviele Fremdbegriffe hmm

Ich werde mich einfach einmal spielen und hoffen dass ich etwas alleine schaff, sollte es nicht funktionieren hörst du sicher wieder von mir =)

(also heut abend =P)

Lg

Hey, me again =)

Sub Zellen_importieren()


Dim i As Integer
For i = 1 To 206
 

 Workbooks.Open Filename:="'C:\Users\it02\Desktop\4500044164 PRÜFPROTOKOLLE\[Right"( & i & )".xls]"             \\ ich schaffs nicht dass er mein "i" als Variable erkennt?!  
 Sheets("Tabelle1").Select  
 
 Range("R10").Select  
 Application.CutCopyMode = False
 Selection.Copy
Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("a500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste

 Range("F9").Select  
 Application.CutCopyMode = False
 Selection.Copy
Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("b500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste

 Range("U28").Select  
 Application.CutCopyMode = False
 Selection.Copy
Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("c500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste

 Range("M28").Select  
 Application.CutCopyMode = False
 Selection.Copy
Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("d500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste

 Range("E28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("e500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste

 Range("M29").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("f500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste
Workbooks("Right"( & i & )".xls").Close SaveChanges:=False  


 Next i
End Sub

Ich dachte mir sowas in der Art? =/
bitte nicht schimpfen wenn es kompletter Blödsinn is xD

Und das jetzt iwie in einen Loop versetzen und i raufzählen lassen bis 206??

Wie setze ich folgende 2 Dinge richtig ein? Die 6 Werte sollen ja nebeneinander stehen, je Datei.

b500 steht für, springe in die letzte beschriebene Zelle in B, checke maximal 500 ab?
und Zeile plus 1 bedeutet, spring noch eine Zelle runter --> also in die Freie?

zeile = Range("b500").End(xlUp).Row  
 Rows(zeile + 1).Select

Diese besagen ja, wenn ich mich nicht Irre, dass er die nächste freie Zeile auswählen soll, also er schreibt in die nächste freie Zelle und kann somit nichts überschreiben was schon im "right all-xlsm" steht, richtig?

Hallo Alex-IT02 ,

ein bisschen Helfen möchte ich auch

Workbooks.Open Filename:="'C:\Users\it02\Desktop\4500044164 PRÜFPROTOKOLLE\[Right"( & i & )".xls]" \\ ich schaffs nicht dass er mein "i" als Variable erkennt?!

bis zu dieser Zeile und auch danach erkennt das Programm dein i als Variable.
Du müßtest deine Zeilen nur ändern in ungefähr so:

for i = 1 to 206
       Workbooks.Open Filename:="C:\Users\it02\Desktop\4500044164 PRÜFPROTOKOLLE\" & i & ".xls"  

' deine weiteren Code-Blöcke  

      Workbooks "C:\Users\it02\Desktop\4500044164 PRÜFPROTOKOLLE\" & i & ".xls".Close SaveChanges:=False   
next
'....  

deine anderen "Blöcke" sollten schon mal vom Prinzip machen, was du vorhast. Eventuell hilft dir aber etwas Vereinfachung, um hier weiterzukommen. Du kannst immer deine 5 Spalten direkt in einem Ruck selektieren
circa so:

Range("R10,F9,U28,M28,E28,M29").Select  
          Selection.Copy
' hier dann deinen Code einfuegen (also erst wieder dein anderes Excelsheet //aktivieren// , in die Zeile gehen, ab wo es weitergeht und dann  
          ActiveSheet.Paste
'....  

damit hast du dann auch gleich alle Werte nebeneinander

Probier mal weiter und melde dich dann wieder

Gruss
Tsuki

Hallo Tsuki,

danke erstmal für deine Hilfsbereitschaft =)

bei Zeile 2 von Code 1 fehlt aber doch noch der Dokumentenname selbst? Right(1), Right(2), Right(3)....
und ja ich war irgendwie zu blöd und konnte ihn nicht richtig einfügen ohne dass ein Kompilierfehler kommt =/

Bei Zeile 3 Code 2 meinst du

er markiert alle gleichzeitig, kopiert diese in die zwischenablage, danach den Code:

 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("A500").End(xlUp).Row  
 Rows(zeile + 1).Select 
 ActiveSheet.Paste

dieser aktiviert die Sammeltabelle, wählt das Tabellenblatt 1 aus und dann?
dann nimmt er doch nur die letzte unbeschriebene Zelle von A oder? Wo sag ich ihm was er wo einfügen soll?

und stimmt meine erklärung für

zeile = Range("A500").End(xlUp).Row  
Rows(zeile + 1).Select 

also wenn deine Exceldateien alle Right(1) bis Right(n) heissen, dann passt du den Pfad so an:

Workbooks.Open Filename:="C:\Users\it02\Desktop\4500044164 PRÜFPROTOKOLLE\Right(" & i & ").xls"

Achte auf die Gänsefüsschen !

Bei Zeile 3 Code 2 meinst du
er markiert alle gleichzeitig, kopiert diese in die zwischenablage, danach den Code:

Richtig!
1) die For-Schleife
2) ExcelDatei öffnen
3) Die 5 Spalten/Zeilen selektieren (in einem Ruck)
4) Dann wieder deine Sammeltabelle aktivieren
5) und jetzt kommt's -> wenn du da zum Beispiel B1 markierst und .paste durchführst,
werden die Werte automatisch in B1,C1,D1,E1, F1 und G1 eingetragen. Immer nach der Reihenfolge von
> Range("R10,F9,U28,M28,E28,M29").Select

und zu deiner letzten Frage:
mit .End(xlDown) sucht er die letzte Zelle, die Werte enthält, bzw hüpft dorthin. Und wenn du dann richtigerweise noch Zeile+1 hinzufügst, steht es in der nächsten Leeren Zeile.
schau dir hierzu mal unter deiner Excel-Hilfe die End-Eigenschaft an!

Generell kann ich empfehlen, neue Codes erst einmal zu testen und damit zu spielen

Gruss
Tsuki

Danke vorerst =)

Hab jetzt mal dieses "Programm" laufen lassen xD Er springt von einem Sheet zum nächsten und das 206 mal =) also das funktioniert schon einmal Prima, aber irgendwie "pastet" er nichts. Das Blatt "right all" ist nachwievor leer hmm

Folgenden Code habe ich jetzt laufen lassen:

Sub Zellen_importieren()


Dim i As Integer
For i = 1 To 206
 
 

 Workbooks.Open Filename:="C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls"  
 Sheets("Tabelle1").Select  

 Range("R10").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("A500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste
 
 Range("F9").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("B500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste
 
 Range("U28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("C500").End(xlUp).Row  
  Rows(zeile + 1).Select
 ActiveSheet.Paste
 
 Range("M28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("D500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste
 
 Range("E28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("E500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste
 
 Range("M29").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 zeile = Range("F500").End(xlUp).Row  
 Rows(zeile + 1).Select
 ActiveSheet.Paste
 
 
 Workbooks("Right (" & i & ").xls").Close SaveChanges:=False  
 
 Next i
End Sub

muss ich ihm die gewünschte Zelle in welcher er springen soll auch noch markieren? Das macht doch bereits

 Rows(zeile + 1).Select

die Kurzform funktioniert nicht, da kommt der Fehler: Dieser Befehl (selection.copy) kann bei nicht angrenzenden Zellen nicht verwendet werden.
Leider

Lg Alex

Hallo Alex-IT02 und Tsuki!

Wenn's doch ohnehin nur um ein paar Werte (und nicht auch deren Formate) geht, würde ich das eher so versuchen (ungetestet):

Sub Zellen_importieren()
Zeile = Range("A500").End(xlUp).Row  
For i = 1 To 206
    Workbooks.Open Filename:="C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls"  
    Sheets("Tabelle1").Select  
    V = Array([R10], [F9], [U28], [M28], [E28], [M29])
    Workbooks("Right (" & i & ").xls").Close SaveChanges:=False  
    Cells(Zeile, "A").Resize(1, UBound(V) + 1) = V  
    Zeile = Zeile + 1
Next i
End Sub

Grüße
bastla

Ihr seits echt schnell und spitze =) musste mal gesagt werden.
Immerhin hilft mir der bastla schon zum 2ten mal =)

Zum ungetesteten Code:

Er bringt leider bei:

Cells(Zeile, "A").Resize(1, UBound(V) + 1) = V

einen objektdefinierten Fehler. Da ich mich bei diesem Code noch weniger auskenn kann ich mir diesen leider überhaupt nicht erklären =/

Liebe Grüße
Alex

Hey Leute =)

ich habe jetzt mal von meinen "Blöcken" die letzten 5 entfernt und "i" auf 1 to 5 gesetzt.

Was nun passiert ist wunderlich. Er holt sich den richtigen Wert, R10 und holt sich auch gleichzeitig seine Formatierung.
Sie werden auch brav untereinander geschrieben.
Wenn ich aber alle Blöcke lasse, kommt überhaupt nichts ? =(

mein nächster Gedanke war, er springt ja nicht nach dem kopieren zum anderen Sheet ud dem anderen Wert zurück, deshalb hab ich ein weiteres Windows().activate hinzugefügt vor jedem Block.

Was er aber jetzt bringt ist noch verwunderlicher...

=MAX('C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\[right (1).xls]Tabelle2'!#BEZUG!)

das Tabelle2 verwundert mich am meisten, hab ich doch extra ein sheets.select beigefügt

Das bekomm ich 8152 mal nach rechts in jede Zelle.
Komisch...
Ebenso wäre interessant was ich machen muss dass er nur den Wert mitnimmt und nicht die Formatierung auch.

Hier der aktuelle Code:

Sub Zellen_importieren()


Dim i As Integer
For i = 1 To 1
 
 

 Workbooks.Open Filename:="C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls"  
 Sheets("Tabelle1").Select  
 
 Range("R10").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 Zeile = Range("A210").End(xlUp).Row  
 Rows(Zeile + 1).Select
 ActiveSheet.Paste

 Windows("Right (" & i & ").xls").Activate  
 Sheets("Tabelle1").Select  
 Range("F9").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 Zeile = Range("K500").End(xlUp).Row  
 Rows(Zeile + 1).Select
 ActiveSheet.Paste
 
 Windows("Right (" & i & ").xls").Activate  
 Sheets("Tabelle1").Select  
 Range("U28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 Zeile = Range("Q500").End(xlUp).Row  
 Rows(Zeile + 1).Select
 ActiveSheet.Paste
 
 Windows("Right (" & i & ").xls").Activate  
 Sheets("Tabelle1").Select  
 Range("M28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 Zeile = Range("D500").End(xlUp).Row  
 Rows(Zeile + 1).Select
 ActiveSheet.Paste
 
 Windows("Right (" & i & ").xls").Activate  
 Sheets("Tabelle1").Select  
 Range("E28").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 Zeile = Range("E500").End(xlUp).Row  
 Rows(Zeile + 1).Select
 ActiveSheet.Paste
 
 Windows("Right (" & i & ").xls").Activate  
 Sheets("Tabelle1").Select  
 Range("M29").Select  
 Application.CutCopyMode = False
 Selection.Copy
 Windows("_right all.xlsm").Activate  
 Sheets("Tabelle1").Select  
 Zeile = Range("F500").End(xlUp).Row  
 Rows(Zeile + 1).Select
 ActiveSheet.Paste
 
 
 Workbooks("Right (" & i & ").xls").Close SaveChanges:=False  
 
 Next i
End Sub

Ganz liebe Grüße
Alex

Hallo Alex-IT02!

Ich habe das oben etwas zu weit abgekürzt - daher hier die ausführliche Fassung meines Vorschlages:

Sub Zellen_importieren()
Zeile = Range("A500").End(xlUp).Row + 2 'Leerzeile einfügen, wenn die alten Daten schon nicht gelöscht werden sollen  
For i = 1 To 206
    Set Q = Workbooks.Open Filename:="C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls"  
    With Q.Sheets("Tabelle1")  
        V = Array(.Range("R10").Value, .Range("F9").Value, .Range("U28").Value, .Range("M28").Value, .Range("E28").Value, .Range("M29").Value)  
    End With
    Q.Close SaveChanges:=False
    Cells(Zeile, "A").Resize(1, UBound(V) + 1) = V  
    Zeile = Zeile + 1
Next i
End Sub

Wären mehr als 6 Zellen gefragt, würde ich das Array per Schleife aufbauen - so scheint es mir noch überschaubar ...

Wenn das Blatt übrigens immer vorweg geleert werden soll, könntest Du die Zeile 2 durch zB

Cells.Clear 'oder Cells.ClearContents  
Zeile = 1

ersetzen ...

Grüße
bastla

Hallo Alex-IT02!

Der Makrorecorder ist ein gutes Hilfsmittel, um an die benötigten Objekte, Methoden und Eigenschaften zu kommen, arbeitet aber mit sehr vielen unnötigen "Select" etc - daher mag ich Deinen Code auch nicht wirklich genauer ansehen oder überarbeiten ...

Ebenso wäre interessant was ich machen muss dass er nur den Wert mitnimmt und nicht die Formatierung auch.

Wenn es nicht per direkten Zugriff auf den Zellwert (wie in meinem Ansatz oben) sein soll, sieh Dir dazu "PasteSpecial" (und dort "PasteType") an.

Grüße
bastla

Hallo Alex-IT02!

bastla hat es schon erwähnt. Zum Testen deines Vorhabens nimm den Makrorekorder
und versuch mal folgendes weil ich würde es etwas anders angehen; es gibt für deine Frage viele Lösungswege
1) öffne dein Excel mit der Sammeltabelle
2) starte den Makrorekorder und bename dein Makro nach einem Namen deiner Wahl
3) öffne aus deiner Sammelmappe die erste deiner Right(n)-Dateien
4) makiere den Wert, den tu benötigst aus Right(n) und füge ihn in die Samelmappe ein, wo er hingehört
5) das machst du mit deinen 6 Werten aus Right(n)
6) dann schliesst du die erste Datei Right(n) und öffnest die nächste Right(n)
7) makierst dort wieder den Wert, den du kopieren möchtest und jetzt gehst du in deiner Sammelmappe
mit End + UP/DOWN/RIGHT oder LEFT an die Stelle, wo du hin möchtest.
8) jetzt kannst du eigentlich wieder aufhören, den Makrorekorder laufen zu lassen.
9) nun öffnest - bearbeiten - du dein neu angelegtes Makro und hast jedemenge passenden Code
10) dann muss da nur noch eine Schleife drum , sodass alle 206 Exceldateien auf diese Art und Weise
automatisch ausgelesen werden können.

Im Anschluss daran - wenn das einmal funktioniert - sollten wir den Code dann vereinfachen.

Gruss
Tsuki

... oder gib doch meinem adaptierten Ansatz eine Chance ...

Grüße
bastla

@bastla,

vollkommen richtig!
Ich denke mir nur, dass es für den TO Spass macht, dabei zu zulernen. Einfach mal die vielen Mögichkeiten
aufzeigen, die es geben könnte und was machen, wenn ich einige Befehle nicht weiss in diesem Fall in Excels VBA
Ich würde dann für mich so erst einmal vorgehen. Der Rekorder spuckt mir die richtige Syntax erst einmal raus.

Abgesehen von dem ganzen sollte unser TO auch wissen, wenn er dann mal sein Programmchen fertig hat: dann nach Möglichkeit vor dem Mittagessen rödeln lassen. Das viele Öffnen und Schliessen von mehreren Exceldateien ist nicht gerade performant und kann schon etwas Zeit in Anspruch nehmen

Gruss
Tsuki

Hallo Tsuki!

Eigentlich wäre ich davon ausgegangen, dass die Versuche des TO bereits aus der Verwendung des Makrorecorders stammen (und diesen Code möchte ich nicht wirklich "verbessern") - ansonsten hast Du aber natürlich Recht ...

Grüße
bastla

Guten Morgen =)

ja Bastla du hast, ohne den Makrorekorder wäre ich wahrscheinlich gar nicht soweit gekommen *gg*. Ebenso habe ich gestern, also bereits vor euren Antworten mit der Formatierung, versucht alles bezüglich pastespecial herauszufinden.
Aber keiner der Befehle lässt sich ohne Problemmeldungen kompilieren, deshalb wollte ich euch nochmal fragen.

und blöde Frage hehe aber was bedeutet TO? xD

Lg Alex

und blöde Frage hehe aber was bedeutet TO? xD

das ist keine blöde Frage!

TO steht für ThreadOpener -> also jemand, der ein Thema aufmacht, eine Frage in einem Forum stellt.

Wo klemmt's denn in deinem Makro noch?

Gruss
Tsuki

Okay, dann bin ich in dieser Hinsicht auch schon mal etwas klüger =)

Bei Bastlas Makro kommt bei:

Set Q = Workbooks.Open Filename:="C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls"  

Die Fehlermeldung: erwartetes Anweisungsende. Nur zur Information, was möchte er mir hier sagen? das der Befehl nicht weiter kompiliert werden kann weil er glaubt hier endet dieser?

Bei meinem Code, die lange Wurst also xD, bin ich auf etwas gestoßen.
Ich habe gestern ja gemeint: ich zitiere

Was er aber jetzt bringt ist noch verwunderlicher... =MAX('C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\[right (1).xls]Tabelle2'!#BEZUG!) das Tabelle2 verwundert mich am meisten, hab ich doch extra ein sheets.select beigefügt Das bekomm ich 8152 mal nach rechts in jede Zelle.

warum er Max und die Tabelle 2 nimmt liegt daran, dass es in der Formel so drinnen steht, und die Formel in der Zeile. Also brauche ich umso mehr nur den Wert.
Das habe ich jetzt geschafft mit:

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Jetzt setze ich i auf 1 zu 1.

Mir ist aber nicht klar warum er jetzt für den 1 Schritt (=5 Werte in 5 Zellen in 1 Zeile) auf einmal 2 Zeilen macht mit 8152 Werten nebeneinander?
Auch die Formatierung für die einzelnen Werte muss ich mir jetzt noch raussuchen, damit ein Datum auch ja ein Datum is =)

Grüße Alex

Hallo Alex,

zu deiner 1ten Frage:
das Set Q = ist meines erachtens zu viel. Eventuell sind da Zeilen zusammengerutscht?

Die anderen Sachen muss ich mir erst mal ansehen.

Gruss
Tsuki

Hey,

die Frage mit der Übernahme der richtigen Formatierung habe ich mir bereits selbst beantwortet:

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Jetzt muss ich nur noch auf das Problem dieser komischen Übername kommen und den Code dann noche etwas hübsch machen. Liegt es vlt an

Zeile = Range("A210").End(xlUp).Row  
 Rows(Zeile + 1).Select

dass er so einen Blödsinn einfügt? was anderes könnte es gar nicht sein denk ich.

Ich hab auch bereits ein

Application.ScreenUpdating = False 'am Anfang  
Application.ScreenUpdating = True 'am Ende  

hinzugefügt =)

VB is echt ein geiler Sch =)

Sollt ich wieder auf etwas draufkommen meld ich mich natürlich sofort,
möchte ja keine Extra-Arbeit verursachen.

Lg

Hallo Alex-IT02!

Ändere das

Set Q = Workbooks.Open Filename:="C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls"  

nach

Set Q = Workbooks.Open("C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls")  

Und vergiss Copy/Paste, wenn Du eh nur die Werte haben willst

Gruß Dieter

Hallo @all!

Und vergiss Copy/Paste

Das hätte ich (hinsichtlich der fehlerhaften Zeile) auch (zumindest partiell) tun sollen

(ich hatte zwar getestet, aber nicht die gesamte Ordnerstruktur nachgebaut und daher einen anderen Pfad und beim Posten dann die "Original"-Zeile von oben kopiert) ...

Grüße
bastla

Hey Dieter,

vielen Dank für deine Nachricht, ich hab es probiert und es hat mit testweise 5 Sheets funktioniert, bis auf die Formatierung.
Die Werte sollten nur die Wertformatierung mitnehmen, nicht die Zeilenformatierung. Also sprich wie bei:

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Ganz verstehen "tu" ich den Code aber leider nicht, ist mir wies aussieht zu fortgeschritten xD

Zeile = Range("A500").End(xlUp).Row + 2             'fügt 2 Leerzeichen nach der letzten beschriebenen Zelle ein  

For i = 1 To 5                                                                                                                                  'die Anzahl der Loops  

    Set Q = Workbooks.Open("C:\Users\IT02\Desktop\4500044164 _  
        PRÜFPROTOKOLLE\Right (" & i & ").xls")                                                                       'öffnet die Datei und deklariert die Datei als Q?  
    With Q.Sheets("Tabelle1")                                                                                                     'ab hier nur mehr Bahnhof =( Arrays? Felder?   
    V = Array(.Range("R10").Value, .Range("F9").Value, .Range("U28").Value, _  
    .Range("M28").Value, .Range("E28").Value, .Range("M29").Value)  
    End With
    Q.Close SaveChanges:=False                                                                                                'nicht speichern beim schließen, aber UBound?, was macht Resize?  
    Cells(Zeile, "A").Resize(1, UBound(V) + 1) = V  
    Zeile = Zeile + 1

Lg Alex

Hallo Alex-IT02!

Versuchs mal hiermit:

Option Explicit

Const Path = "C:\Users\IT02\Desktop\4500044164 PRÜFPROTOKOLLE\Right (%1).xls"  

Const ZellAdressen = "R10,F9,U28,M28,E28,M29"  

Const StartZeile = 2                    'Werte ab Zeile ? eintragen  

Sub Zellen_Import()
    Dim Fso As Object, Wks As Worksheet, Zellen As Variant
    Dim File As String, NextLine As Long, i As Integer, c As Integer
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    Set Wks = ThisWorkbook.Sheets(1)
    
    Zellen = Split(Replace(ZellAdressen, " ", ""), ",")  
    
    NextLine = StartZeile
    
    For i = 1 To 5
        File = Replace(Path, "%1", i)  
        
        If Fso.FileExists(File) Then
            With Workbooks.Open(File)
                For c = 0 To UBound(Zellen)
                   .Sheets(1).Range(Zellen(c)).Copy
                    Wks.Cells(NextLine, "A").Offset(0, c).PasteSpecial Paste:=xlPasteValuesAndNumberFormats  
                Next
               .Close False
            End With
            NextLine = NextLine + 1
        Else
            MsgBox "Datei nicht gefunden:" & vbCr & vbCr & File  
        End If
    Next
End Sub

Gruß Dieter

[edit] Codezeile 17 geändert [/edit]

Alsooo meine allerliebsten Helfer =)

Ihr seits Spitze, vielen Dank für die Hilfe.
Ich habe mich jetzt für die Version von Bastla entschieden, ich versteh sie leider nur dezent und perfektioniert ist sie auch noch nicht (wegen meinen Inbox-things),
aber es erfüllt seinen Zweck.

Ihr habt auch meine Lust angekurbelt mich mehr mit VB auseinanderzusetzen, einfach geil =)

Hier das Endresultat unserer Arbeit.

Sub Zellen_importieren()

MsgBox "Bitte stellen Sie sicher dass sich der Ordner Prüfprotokolle auf dem Desktop befindet und keine Unterordner beinhaltet," & vbCrLf & _  
"Die Dateien selbst müssen 'Right' heißen und eine fortlaufende Nummer haben!"  

Dim x As String
Dim y As Integer

x = InputBox("Bitte geben Sie Ihren Benutzernamen ein", "Anzahl der ExcelDateien", Environ("USERNAME"))  ' Benutzernamen für richtigen Desktoppfad  
'If myValue Is not  Then myValue = DefaultValue  

y = InputBox("Bitte geben Sie die Anzahl der Right-Dateien an,")   ' Anzahl der Sheets die Zusammengeführt werden sollen  

Zeile = Range("A500").End(xlUp).Row + 2  

For i = 1 To y

    Application.ScreenUpdating = False
    
    Set Q = Workbooks.Open("C:\Users\" & x & "\Desktop\4500044164 PRÜFPROTOKOLLE\Right (" & i & ").xls")  

    With Q.Sheets("Tabelle1")  
    V = Array(.Range("R10").Value, .Range("F9").Value, .Range("U28").Value, .Range("M28").Value, .Range("E28").Value, .Range("M29").Value)  
    End With
    Q.Close SaveChanges:=False
    Cells(Zeile, "A").Resize(1, UBound(V) + 1) = V  
    Zeile = Zeile + 1

Next i

Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit

Application.ScreenUpdating = True
    
MsgBox "Daten wurden Übertragen"  

End Sub

Lg Alex und wir hören uns sowieso fix wieder hehe

Hallo Alex-IT02!

ich versteh sie leider nur dezent

Da sollte sich doch etwas machen lassen:

Zunächst wird mit "Set Q =" die Quelldatei in eine Objektvariable übernommen - dadurch wird sie in weiterer Folge direkt ansprechbar.
Der "With"-Block entspricht einem mathematischen "Herausheben" - anstatt "Q.Sheets("Tabelle1").Range("R10").Value" schreiben zu müssen, wird die (für alle gleiche) Tabellenangabe nur einmal benötigt.
In V wird ein Array von Werten (weil ein solches Array in einem Arbeitsgang geschrieben werden kann - siehe Zeile 30) zusammengestellt - das ist der am wenigsten elegante und übersichtliche Teil (wie eine Lösung per Schleife - würde ich für eine größere Anzahl von Zellen auf jeden Fall empfehlen - aussehen kann, hat Dieter gezeigt).
Damit das Array beim Eintragen "passt", wird nach der Angabe der Startzelle die Größe des Bereiches per "Resize" festgelegt - es bleibt bei der "Höhe" von einer Zeile, während für die Ermittlung der "Breite" die Größe des Arrays festgestellt werden muss (ok, dass es 6 Zellen sind, wissen wir zwar, aber flexibler wird es per "Automatik"), und da die Elemente im Array mit 0 beginnend nummeriert sind, ist UBound(V) + 1" erforderlich.

----

perfektioniert ist sie auch noch nicht

Auch da könnte ich vielleicht ein wenig beitragen ...

Zunächst einmal die Frage, warum die Anzahl der Dateien eingegeben werden muss - sollen denn nicht alle entsprechend benannten Dateien verwendet werden?
Außerdem: Wird das Script von einem Admin ausgeführt (da ansonsten kein Zugriff auf den Profilordner eines anderen Benutzers möglich sein sollte)?
Variablendeklarationen per "Dim" sind besonders dann sinnvoll, wenn Du sie konsequent für alle Variablen vornimmst und mit einem "Option Explicit" vorweg kombinierst - das Festlegen der Variablen "y" ist allerdings nur als "Absichtserklärung" zu werten - wenn als Anzahl ein nicht-numerischer Wert (oder garnix) eingegeben wird, nützt das "As Integer" nicht nur nicht, sondern das Script läuft in einen "Type mismatch"-Error - daher besser die Eingabe als String (oder Variant) "entgegennehmen" und dann zB mit "If IsNumeric()" prüfen.
Da es offensichtlich eine größere Anzahl von Zeilen geben kann (und nach derzeitigem Stand auch keine alten Werte überschrieben werden sollen), würde ich den Zeilenwert "500" in Zeile 17 überdenken ...
Zeile 35 ist unnötig.

Grüße
bastla

Hallo Bastla und Hallo alle Mitleser =)

Danke für die Erklärung.

Also bedeutet "1,UBound(V)"
1 für die Höhe, also Größe beibehalten, Faktor 1:1 vlt?
und UBound für die Breitenautomatik, wobei er die Breite automatisch an die Variable V (=die Arrays) anpasst. und das "+ 1 steht" dann für? um 1 weiter nach rechts?

Zum Verschönern:

Die Anzahl der Sheets is nie genau 206. Sie wird immer variieren, deshalb wollte ich die Möglichkeit geben es individuell eingeben zu können?! gibt es ne schönere Variante? =)

Das Script wird von einem Benutzer ausgeführt der keine höheren Rechte besitzt. In späterer Folge kann es auch passieren dass das Script auch von jemand anderem ausgeführt wird.
Ich wollte versuchen die Möglichkeit zu schaffen dieses Script ziemlich individuell zu gestalten, Unabhängig vom Benutzer. Auch hier fehlt mir leider die Erfahrung und ich weiß deshalb nicht was alles möglich wäre.

Was meinst du mit Variablen per "Option Explicit" kombinieren? "option explicit" ist dies wie eine Bedingung? sodass wenn ich option explicit on schreibe, dann aber eine Variable nicht richtig und eindeutig deklariert ist,
ich eine Fehlermeldung bekomm beim Kompilieren?

Der Ansatz mit If is Numeric gefällt mir sehr gut. Würde dann folgendes passen?

goto Dateianzahl

y = InputBox("Bitte geben Sie die Anzahl der Right-Dateien an,")   ' Anzahl der Sheets die Zusammengeführt werden sollen   

            If (IsNumeric(x) Then
               goto: weiter
            Else
                MsgBox("keine gültige Zahl")  
            goto: Dateianzahl
            End If
goto weiter

mit den "500" hast du natürlich recht. Kann man hier eventuell auch eine Art Autorange Variante verwenden? Existiert so etwas?

Lg Alex

Hallo Alex,

bastla wird's sicher noch besser erklären können, aber eines vorneweg:

Also bedeutet "1,UBound(V)"

Nein!
Es handelt sich hierbei um ein Array - da bitte mal selber googeln, was das ist! - und alle Arrays
fangen mit 0 an. Kleines Beispiel:

a = Array("0","1","2")  
for i = 0 to Ubound(a)
     msgbox a(i)
next

das heisst, dass a(0) = 0 ; a(1) = 1 und a(2) = 2
Ubound gibt dir nur den höchsten möglichen Feldindexwert eines Arrays zurück - das ist eine Integerzahl und in unserem Beispiel wäre diese 2

2) bei deinem Codeschnipsel stört nur die erste Zeile. Die müßte heissen:

Dateianzahl:

Sicherlich mehr dazu wird dir bastla noch erklären.

Gruss
Tsuki

Hey Tsuki,

danke für die Erklärung. Array hab ich bereits gegoogelt und bin bissl schlauer worden =)
Zum Codeschnipsel:

wenn bei "goto Dateianzahl" das goto zuviel ist, nehm ich einmal an dass die Zeile 11 auch mit "weiter" genügt?

Lg Alex

Hallo Alex und Tsuki!

1 für die Höhe, also Größe beibehalten, Faktor 1:1 vlt?

1 = neuer Bereich ist umfasst 1 Zeile
UBound() hat Tsuki ohnehin schon (ausführlicher als ich oben) erklärt ...

Was meinst du mit Variablen per "Option Explicit" kombinieren? "option explicit" ist dies wie eine Bedingung? sodass wenn ich option explicit on schreibe, dann aber eine Variable nicht richtig und eindeutig deklariert ist,

ich eine Fehlermeldung bekomm beim Kompilieren?
Genau das ist der Plan - damit fallen Dir Schreibfehler in Variablennamen leichter auf ...

Hinsichtlich der Zahleneingabe:
Wenn Du den Benutzer ohnehin dazu zwingen willst, eine Zahl einzugeben, kannst Du das ja gleich so lösen:

Do
    y = InputBox("Bitte geben Sie die Anzahl der Right-Dateien an,")   ' Anzahl der Sheets die Zusammengeführt werden sollen  
    If Not IsNumeric(y) Then MsgBox("keine gültige Zahl")  
Loop Until IsNumeric(y)

eine Art Autorange Variante

könnte mit einem Sprung von oben nach unten realisiert werden:

Zeile = Range("A2").End(xlDown).Row + 2

- oder Du beginnst einfach bei A65536 ...

Die Anzahl der Sheets is nie genau 206

Deswegen die Frage, ob nicht einfach alle Dateien des Ordners verarbeitet werden sollen ...

Grüße
bastla

@ Alex,

nehm ich einmal an dass die Zeile 11 auch mit "weiter" genügt

Fast! Die Doppelpunkte wären noch wichtig! Also

weiter:

Die Doppelpunkte sind für eine Sprungmarke wichtig. Ansonsten hast du Recht!
Nur einmal GOTO, nämlich wenn du von einer bestimmten Stelle an eine bestimmte Sprungmarke springen möchtest.

@bastla
ich wollte dir nicht zuvorkommen! Du kannst die Materie eh besser erklären, als ich. Da kann man(n) sehr viel lernen!

Danke und Gruss
Tsuki

Hey ihr beiden,

ihr seits beide der Wahnsinn. Und das Ganze macht auch noch richtig Spaß. Ebenso werden mir nicht die Lösungen vorgegeben sondern ich werd zum Selberdenken angeregt.
Find ich verdammt gut.

durch diese Do-Schleife muss jetzt auch dieses " option explicit" verwendet werden kann das sein?
Ich hab bereits Typen vergeben, aber wsl unnötige und falsche. Wie was deklariert werden soll werd ich mir durch Eigenstudium zur Gemüte führen.

Dim x As String
Dim y As Integer
Dim Zeile As String
Dim i As Integer
Dim Q As Object
Dim V As String

das war mal mein Anfang. Er schreit jedoch dennnoch noch dass ihm das Ubound nicht passt.

"UBound erwartet Datenfeld"

Alternative: alle Dims weglassen und das option explicit?

Kann ich auch generell auf "Errors" reagieren? Indem ich zum Beispiel:

On Error GoTo ende                             'das setz ich nach der letzten Inputbox hin?! oder gleich nach dem Sub?  
ende:                                                        'steht ganz am Ende des Makros,  
msg("Konnte nicht korrekt ausgeführt werden")  
End Sub

Dieser Code funktioniert iwie nicht so wie ich es gerne hätte.

Und durch dieses Loop komme ich gar nicht mehr raus aus der Schleife? weder durch das X noch sonst wie?
Muss ich hier wieder extra ein IF hinzufügen damit ich das Skript abbrechen kann und die Error-Meldung ausgegeben wird?

Lg Alex

Hallo Alex

Kann ich auch generell auf "Errors" reagieren? Indem ich zum Beispiel:

Ja, kannst du. Hat aber den faden Beigeschmack, dass du dann nicht weisst, warum er nach ende: gesprungen ist.
Besser ist es bei Abfragen genau auf die Eingaben einzugehen.

Wenn ein Ubound nicht passt, dann gibt es einige Möglichkeiten dafür. Was du auf keinen Fall machen solltest, ist dieses zu deklarieren. Also nicht auf direktem Wege

Das Ubound ergibt sich! Siehe mein vorhergehendes Beispiel.
Wenn wir's noch um eine weitere Messagbox ergänzen, dann sähe
es so aus:

a = Array("0","1","2")  
for i = 0 to Ubound(a)
     msgbox a(i)
next
msgbox ubound(a)

Gruss
Tsuki

Hallo Tsuki!

Ja, kannst du. Hat aber den faden Beigeschmack, dass du dann nicht weisst, warum er nach ende: gesprungen ist.

Naja, Du kannst zumindest Err.Number auswerten ...

Das Array V kann vorweg As Variant deklariert werden.

Grüße
bastla

Hallo Alex!

Und durch dieses Loop komme ich gar nicht mehr raus aus der Schleife? weder durch das X noch sonst wie?

Wenn die InputBox abgebrochen oder einfache keine Eingabe vorgenommen wird, enthält y danach "", was Du natürlich abfragen kannst:

Do
    y = InputBox("Bitte geben Sie die Anzahl der Right-Dateien an,")   ' Anzahl der Sheets die Zusammengeführt werden sollen  
    If y <> "" And Not IsNumeric(y) Then MsgBox ("keine gültige Zahl")  
Loop Until IsNumeric(y) Or y = ""  
If y = "" Then  
    MsgBox "Na gut, dann nicht ..."  
    Exit Sub
End If

Grüße
bastla

Hallo bastla,

das ist mit Sicherheit die Möglichkeit, um etwaige Fehler einzugrenzen. Bin ich gar nicht gleich drauf gekommen.
Man muss halt nur für die gewissen Sachen die Fehlercodes, bzw. -nummern wissen. Aber dann ist es eine super Lösung!

Bei der Deklaration des Arrays stimme ich dir vollendst zu! Danke!

Viele Grüße

Tsuki