Frage von DarkxAxngel, 41

Excel Makro: Automatisches Erkennen und kopieren?

Hallo ich bin gerade an einen Makro schreiben, ich hab hier mehre Tabellen in verschieden Dateien (Excel).

Sie Fangen alle bei A12 an und haben eine breite von 9 ( spricht I).

Nun möchte ich das mein Makro mit einer einfachen While schleife erkennt wann eine leere Zelle kommt im A block(Von oben nach unten). Falls eine kommt geht er aus die While raus und kopiert von A12 und der erkannten Zeile. Makiert die erste leere Spalte und fügt die Kopie ein.

Dim Cords As Integer
Cords = Int(12)




Do While Cells(1, Cords) = ""
Cords = Int(Cords + 1)
Loop

Range(Cells(1, 12), Cells(9, Cords)).Select
Selection.Copy

Cords = Int(Cords + 1)

Range(Cells(1, Cords), Cells(1, Cords)).Select

ActiveSheet.Paste
Hilfreichste Antwort - ausgezeichnet vom Fragesteller
von Ninombre, Community-Experte für Excel, 19

Da fehlt die eigentliche Frage, oder?

Ich rate also etwas: Das Makro in der bisherigen Form wird so nicht funktionieren (aber trotzdem Daumen hoch, dass Du Dich nicht von VBA / Makro abschrecken lässt!)

das int brauchst Du nicht, Du definierst ja den Anfangswert von cords als Ganzzahl und erhöhst um Ganzzahlen.

Beim Wechsel zwischen Dateien solltest Du meiner Erfahrung nach mit konkreten Dateinamen arbeiten und activeworkbook oder activesheet vermeiden, das kann zu Fehlern führen, wenn gerade nicht das vorgehene Blatt bzw. die Datei aktiv sind.

bei den Angaben mit cells ist die Reihenfolge anders als bei normalen Formeln, also erst die Zeile (rows) dann die Spalte (columns). Das war in Deinem Entwurf teilw. verdreht.

Statt select und selection.copy bzw. den gleichen Weg für das Paste kannst Du das direkt in einen Befehl packen. Der Makrorekorder zeichnet da sehr "wörtlich" auf, indem die Markierung mit der Maus als select getrennt erfasst wird.

In der Do/While fragst Du auf die Bedingung ab, dass die Zelle leer ist - der formulierten Frage nach soll aber bis zu einer leeren Zeile gesucht werden, d.h. es muss hochgezählt werden solange eben die aktuelle Zeile nicht leer ist.

Zwei Fragen bleiben für mich aber noch offen:
- Warum erfolgt noch ein cords=cords+1? Soll der ganze Ablauf (Suche nach der leeren Zeile, Kopieren/Einfügen) noch einmal wiederholt werden?

- Wohin genau soll das kopierte Ergebnis eingefügt werden? Direkt ab A1 oder in der Zieldatei erstmal die leere Zeile suchen?

Mappe1 ist beim Beispiel die Quelldatei
Mappe4 das Ziel

Wenn Fehlermeldungen wegen Index überschritten kommen, stimmt etwas mti den Dateinamen/Pfaden oder Tabellenbezeichnungen noch nicht. Das müssten wir dann noch rausfummeln.

Dim Cords As Integer
Cords = 12
Do While Workbooks("Mappe1.xlsx").Sheets("Tabelle1").Cells(Cords, 1) <> ""
Cords = Cords + 1
Loop
Workbooks("Mappe1.xlsx").Sheets("Tabelle1").Range(Cells(12, 1), Cells(Cords, 9)).Copy Destination:=Workbooks("Mappe4.xlsx").Worksheets("Tabelle1").Cells(1, 1)
Kommentar von DarkxAxngel ,

Hallo danke für diese tolle Antwort! (:

das Cords+1 sollte dienen das eine Zeile von Links nach rechts frei wird. Dannach sollte er sich unterhalb der gefüllten Daten befinden und von dort aus die Daten einfach drunter kopieren.

Später soll es so sein, dass ich einfach eine Hauptmappe angebe und in den Nebenmappen das Makro ausführe. So dass die daten unter einander am ende in der Hauptmappe befinden.

Und noch mal zu verständigigung bei meinen Dreher cells(12,A) wäre richtig und nicht (A,12) ?

Kommentar von DarkxAxngel ,

Und ja es funktionierte nicht so ganz , es wurde zwar ausgeführt aber leider passierte nichts. Ich habe voher nur mit Java gearbeitet und bekomme auf einmal so eine Aufgabe ^^

Kommentar von DarkxAxngel ,

Und ich kann ein bisschen C# , was auch viel einfacher ist als VBA ^^

Kommentar von DarkxAxngel ,
Soweit funktionert es. Wenn mir noch sagen kannst wie man auf eine ander Datei/Excel zugreifft 
und dort weiter das selbe Makro auführt
Sprich er erkennt wo die erste leere zeile ist wieder und fügt aus ablage von der ersten mappe ein)

Dim Cords As Integer
Cords = Int(12)

While Cells(Cords, 1) <> ""
Cords = Int(Cords + 1)
Wend

Range(Cells(12, 1), Cells(Cords, 9)).Select
Selection.Copy

Cords = Int(Cords + 1)// Wird enfernt

Range(Cells(Cords, 1), Cells(Cords, 1)).Select

ActiveSheet.Paste
Kommentar von DarkxAxngel ,

Wenn es möglich ist der name von den nebenmappen ist nicht bekannt sprich er soll alle durchgehen die im ordner sich befinden und sie der haupt exel datei einfügen.

Kommentar von Ninombre ,

dja, erst die Zeile dann die Spalte, beides aber als Zahl: Die Zelle A12 ist cells(12,1)

Vom Grundsatz her sollte das Makro aber in der Hauptdatei laufen, die verschiedenen Nebendateien öffenen und die relevanten Inhalte
herauskopieren. Damit das Makro in der Datei gespeichert werden kann, muss das Dateiformat ja als xlsm oder ähnliches hinterlegt sein.

Liegen in dem Verzeichnis dann nur relevante Exceltabellen? Das müsste man sonst noch abfragen.

Mal ein Entwurf mit einer Frage allerdings: Soll in den Nebendateien immer ab Zeile 12 gesucht werden? So hatte ich das aus der Frage verstanden:

Damit die kopierten Einträge in der Hauptdatei immer in der jeweils nächsten leeren Zeile beginnen, kann man die letzte benutzter Zeile so abfragen:

das +1 sorgt dafür, dass nicht in die letzte benutzter Zeile geschrieben wird (das wäre sonst überschreiben), sondern in die darauffolgende:

Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim quelldatei As String, pfad As String, i As Integer, cords As Integer
pfad = "U:\test\"
quelldatei = Dir$(pfad & "*.*")
Do While quelldatei <> ""
If quelldatei <> "hauptdatei.xlsm" Then
cords = 12
Workbooks.Open (pfad & quelldatei)
While Workbooks(quelldatei).Sheets("Tabelle1").Cells(cords, 1) <> ""
cords = cords + 1
Wend
End If
Workbooks(quelldatei).Sheets("Tabelle1").Range("A12:I" & cords).Copy Destination:=Workbooks("hauptdatei.xlsm").Worksheets("Tabelle1").Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
quelldatei = Dir$()
Loop
Expertenantwort
von Suboptimierer, Community-Experte für Excel, 17

Uiuiuiui, da ist einiges sehr gewöhnungsbedürftig. 12 ist bereits ein ganzzahliger Wert. Du musst ihn nicht noch mit Int casten.

Cells(1, Cords) fängt bei Zeile 1, Spalte 12 an. Ich denke, hier hast du einen Dreher.

Ich würde das so machen:

Sub Kopieren()
  Dim bLeer As Boolean
  Dim i As Integer
  Dim iZeile As Integer
  Dim iSpalte As Integer

iZeile = 12 While Cells(iZeile, 1) <> "" iZeile = iZeile + 1 Wend iZeile = iZeile - 1
iSpalte = 2 bLeer = False While Not bLeer bLeer = True For i = 12 To iZeile If Cells(i, iSpalte).Value <> "" Then _ bLeer = False Next iSpalte = iSpalte + 1 Wend iSpalte = iSpalte - 1
Range(Cells(12, 1), Cells(iZeile, 1)).Copy Cells(12, iSpalte) End Sub

Anstelle der For-Schleife kannst du auch schreiben:

bLeer = WorksheetFunction.CountA(Range(Cells(12, iSpalte), Cells(iZeile, iSpalte))) = 0
Kommentar von DarkxAxngel ,

Ich hab mal deins Reingehauen als Script , leider ohne erfolg x.x

Kommentar von Suboptimierer ,

Schade

Keine passende Antwort gefunden?

Fragen Sie die Community