Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Bandog29 vom 04.09.2019, 17:46 Options

Problem mit Makro

Hallo liebe Forengemeinde,

ich habe folgendes Problem:

Ich möchte Daten aus 2 (teilweise auch mehr) verschiedenen Exceldateien in einer 3. Tabelle zusammenfassen (mittels eine Befehlsschaltfläche).

Dieser Vorgang wiederholt sich ständig, so das die Zieldatei ständig wächst. Ich habe ein Makro aufgezeichnet und es der Befehlsschaltfläche zugeordnet.

Das Makro sieht folgendermaßen aus:

Sub Schaltfläche2_BeiKlick()
ActiveWindow.ActivateNext
Range("A1:J55").Select
Selection.Copy
ActiveWindow.ActivateNext
ActiveWindow.ActivateNext
Sheets("GPO 2007").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("K1241").Select
ActiveCell.FormulaR1C1 = "Ende"
Range("A1242").Select
ActiveWindow.ActivateNext
ActiveWindow.ActivateNext
Range("A1:J55").Select
Selection.Copy
ActiveWindow.ActivateNext
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("K1248").Select
ActiveCell.FormulaR1C1 = "Ende"
Range("A1249").Select
End Sub

Mein Problem: Die einzulesenden Dateien sind immer unterschiedlich groß von der Zeilenanzahl. Deswegen habe ich den Befehl "Strg + Pfeiltaste down" benutzt, um an das Ende der Tabelle zu gelangen damit die Daten dernachfolgenden Datei direkt darunter eingefügt werden.

Excel erkennt diesen Befehl aber nicht sondern setzt die Zellposition fest im Code ein (siehe Fettschrift im Makro).

Was muss ich tun, damit Excel immer genau eine Zelle unter der zuletzt beschrifteten Zelle geht?

Vielen Dank schon mal im voraus!!

Gruß
Thorsten

Antwort schreiben

Antwort 1 von Beverly vom 05.09.2019, 07:52 Options

Hi Thorsten,

die letzte belegte Zelle in Spalte A kann man mit diesem Code ermitteln

 IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)

In deinem Code müsste das dann für die 1. freie Zelle in Spalte K heißen Range("K" & IIf(IsEmpty(Cells(Rows.Count, 11)), Cells(Rows.Count, 11).End(xlUp).Row, Rows.Count + 1).

In VBA kann zu 99% auf Select und Activate verzichtet werden. z.B.

 Range("A1:J55").Select
Selection.Copy

kannt du vereinfachen zu

 Range("A1:J55").Copy

Oder

Range("K1248").Select
ActiveCell.FormulaR1C1 = "Ende"

wird zu

Range("K1248") = "Ende"

Bis später,
Karin

Antwort 2 von Bandog29 vom 05.09.2019, 11:08 Options

Hallo Karin,

vielen dank für die Antwort!

Wo genau muss denn der Code durch deine Änderungen ersetzt werden?

Kannst du vielleicht mein Beispiel nehmen und es so abändern das es funktioniert? In VBA bin ich leider nicht wirklich ein Experte.

Vielen Dank für deine Mühe!

Viele Grüße
Thorsten

Antwort 3 von Beverly vom 05.09.2019, 12:09 Options

Hi Thorsten,

wenn ich dein Vorhaben richtig verstanden habe, dann sollte es auf diese Weise funktionieren

Sub Schaltfläche2_BeiKlick()
    Dim wbMappe As Workbook
    Dim wsTabelle As Worksheet
    Dim loLetzte As Long
    Set wsTabelle = ThisWorkbook.Worksheets("GPO 2007")
    loLetzte = IIf(IsEmpty(wsTabelle.Cells(Rows.Count, 1)), wsTabelle.Cells(wsTabelle.Rows.Count, 1).End(xlUp).Row, wsTabelle.Rows.Count)
    For Each wbMappe In Excel.Workbooks
        [b]If wbMappe.Name <> ThisWorkbook.Name And wbMappe.Name <> "PERSONL.XLS" [/b]Then
            With wbMappe.Worksheets("Tabelle1") '<== hier den Namen der Tabelle anpassen, aus der kopiert wird
                .Range("A1:J55").Copy wsTabelle.Cells(loLetzte + 1, 1)
                loLetzte = IIf(IsEmpty(wsTabelle.Cells(Rows.Count, 1)), wsTabelle.Cells(wsTabelle.Rows.Count, 1).End(xlUp).Row, wsTabelle.Rows.Count)
                wsTabelle.Cells(loLetzte, 11) = "Ende"
            End With
        End If
    Next wbMappe
End Sub

Wenn du außer den Mappen, aus denen kopiert werden soll noch andere geöffnet hast, musst du in der fett markieren Zeile alle Namen dieser Mappen nach demselben Prinzip aufführen bzw. ergänzen, aus denen nicht kopiert werden darf. ThisWorkbook ist die Mappe mit dem Code, also in die kopiert werden soll. Da es auf den meisten Rechnern eine PERSONL.XLS gibt, habe ich diese gleich mit aufgeführt.

Der Code geht davon aus, dass in Spalte A Zelle A55 immer ausgefüllt ist.

Bis später,
Karin

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken