Clever-Excel-Forum

Seiten: 1 2

Hallo zusammen,

mein Ziel ist es ein Makro zu schreiben mit dem ich durch starten im Mastersheet Dateien auswählen kann von denen im Zweiten Reiter die Daten aus A7:H22 kopiert und im Mastersheet untereinander eingefügt werden.
Ich habe mir folgenden Code aus dem Internet zusammenkopiert.

Code:
Sub Workbook_Open()

' BILDSCHIRMAKTUALISIERUNG (ANZEIGE) AUS!

Application.ScreenUpdating = False

' DIM DER PROJEKTE ALS ARBEITSMAPPEN

Dim wbPro As Workbook

' DIM DES ZIELS ALS ARBEITSMAPPE

Dim wbZiel As Workbook

' DIM DES ZIELS ALS ARBEITSBLATT

Dim wSZiel As Worksheet

' DIM DER ANZAHL DER IN DEN PROJEKTEN ENTHALTENEN BLÄTTER

Dim shcount As Integer

' DIM i FÜR DIE SCHLEIFE DURCH DIE ARBEITSBLÄTTER; JEDES i = EIN BLATT

Dim i As Integer

' DIESE ARBEITSMAPPE ALS ZIEL FESTLEGEN

Set wbZiel = ThisWorkbook

Set wSZiel = wbZiel.Worksheets(1)

' DIMs FÜR DIE DATEIAUSWAHL

Dim filenames, f

    Dim x As Integer

    Dim myMsg As String

    ' DATEIDIALOG IM PFAD DIESER MAPPE ÖFFNEN

    ChDir ThisWorkbook.Path

    ' filenames = DIE NAMEN DER AUSGEÄHLTEN PROJEKTE

    filenames = Application.GetOpenFilename(FileFilter:="Excel VBA files (*.xls*), *.xls*", _

                                            FilterIndex:=1, _

                                            Title:="Bitte wähle die Projekte aus!", _

                                            MultiSelect:=True)

    ' WENN filenames NAMEN ENTHÄLT (>0) DANN IST X DIE ANZAHL

    If IsArray(filenames) Then

        x = UBound(filenames) - LBound(filenames) + 1

        myMsg = "Du hast " & x & " Projekte ausgewählt."

        'Display full path and name of the files

        MsgBox myMsg

    Else

        MsgBox "Du hast keine Projekte ausgewählt!"

        Exit Sub

    End If

'######################################

'# BEGINN DES LOOPS durch die Dateien #

'######################################

' f IST DER DATEINAME, ALSO NACHFOLGENDER CODE WIRD FÜR JEDE DATEI DURCHLAUFEN

For Each f In filenames

    ' "wbPro" IST NUN DIE DATEI MIT DEM NAMEN AUS "f"; DIESE WIRD GEÖFFNET

    Set wbPro = Workbooks.Open(Filename:=f)

    ' ZÄHLUNG DER VORHANDENEN ARBEITSBLÄTTER IN "wbPro"

    shcount = wbPro.Worksheets.Count

'######################################

'# BEGINN DES LOOPS durch die Sheets  #

'######################################

' JEDES i IST EIN WORKSHEET IN DER ZUR ZEIT GEÖFFNETEN DATEI "f", GENANNT wbPro

' IN DIESEM FALL LOOPT DAS SCRIPT NIHCT DURCH ALLE SHEETS, Sondern nimmt das zweite Sheet

For i = 2 To i = 2

    With wbPro.Worksheets(i)

    ' NEUE ERMITTLUNG DER LETZTEN GEFÜLLTEN ZEILE IM ZIELARBEITSBLATT; HIER IN SPALTE 1 (A)

    Dim LR_Ziel As Integer

    LR_Ziel = wSZiel.Cells(Rows.Count, 1).End(xlUp).Row

' AKTIVIERUNG DES ZIELS, UM ZELLEN MARKIEREN ZU KÖNNEN

wSZiel.Activate

' MARKIERUNG DER ZELLEN VON SPALTE 1 BIS 8 (A-H), 1 ZEILEN UNTERHALB DER LETZTEN GEFÜLLTEN ZEILE IN C

wSZiel.Range(Cells(LR_Ziel + 1, 1), Cells(LR_Ziel + 1, 8)).Select

    ' JETZT WIRD DIE LETZTE BESCHRIEBENE ZELLE IM AKTUELLEN BLATT ERMITTELT (LR), HIER IN SPALTE 1

    Dim LR As Integer

    LR = wbPro.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row

'######################################

'# BEGINN DES LOOPS durch das BLATT i #

'######################################

' FÜR JEDES J VON ZEILE 7 (erste Zeile der Daten) BIS LR (letzte beschriebene Zeile)

Dim j As Integer

For j = 7 To LR - 1

' INNERHALB DIESES LOOPS DURCH DIE ZEILEN MUSS LR_Ziel IMMER WIEDER NEU ERMITTELT WERDEN, UM JEDEN EINTRAG UNTER DEN VORHERIGEN ZU SCHREIBEN.

' HIER SCHON IN DER ERMITTLUNG MIT + 1, SODASS LR_Ziel NUN DIE ERSTE LEERE ZEILE IM ZIEL IST

LR_Ziel = wSZiel.Cells(Rows.Count, 1).End(xlUp).Row + 1

' NUN WERDEN INS ZIEL DIE WERTE AUS DER AKTUELLEN ZEILE j WEGGESCHRIEBEN.

wSZiel.Cells(LR_Ziel, 1).Value = wbPro.Cells(j, 1).Value

wSZiel.Cells(LR_Ziel, 2).Value = wbPro.Cells(j, 2).Value

wSZiel.Cells(LR_Ziel, 3).Value = wbPro.Cells(j, 3).Value

wSZiel.Cells(LR_Ziel, 4).Value = wbPro.Cells(j, 4).Value

wSZiel.Cells(LR_Ziel, 5).Value = wbPro.Cells(j, 5).Value

wSZiel.Cells(LR_Ziel, 6).Value = wbPro.Cells(j, 6).Value

wSZiel.Cells(LR_Ziel, 7).Value = wbPro.Cells(j, 7).Value

wSZiel.Cells(LR_Ziel, 8).Value = wbPro.Cells(j, 8).Value

'######################################

'#  NÄCHSTE ZEILE IM AKTUELLEN BLATT  #

'######################################

Next j

End With

'#########################################

'# NÄCHSTES BLATT IN DER AKTUELLEN DATEI #

'#########################################

Next i

' DATEI FERTIG WEGGESCHRIEBEN!!!!!!!!!

' AKTUELLE DATEI SCHLIESSEN, OHNE SIE ZU SPEICHERN!

wbPro.Close False

'######################################

'#           NÄCHSTE DATEI            #

'######################################

Next f

' ALLE ZEILEN ALLER BLÄTTER ALLER DATEIEN INS ZIEL GESCHRIEBEN!

' BILDSCHIRMAKTUALISIERUNG (ANZEIGE) WIEDER AN!

Application.ScreenUpdating = True

End Sub

Das Makro läuft soweit ohne Fehlermeldung durch und ich kann Anfangs auch die Dateien auswählen alelrdings wird nichts in mein Mastersheet kopiert.

Vielen Dank für eure Hilfe und entschuldigt bitte falls es sich im banale Fehler handelt hatte erst letzte Woche meinen VBA einführungskurs :29:

Hallo,

ohne mich jetzt durch deinen ganzen Code geackert zu haben (denn das macht mir keinen Spaß), empfehle ich dir, den Code schrittweise mit F8 durchlaufen zu lassen. Damit siehst du sofort, welcher Schritt was (nicht) macht und kann das ist oft sehr hilfreich (nicht vergessen Application.ScreenUpdating = False auszukommentieren, sonst siehst du gar nix).

Kleiner Hinweis noch für das Posten hier im Forum: Bitte setze Codes in Codetags, das erleichtert das Lesen ungemein.
["code"] Dein Code hier ["/code"]
nur ohne die Anführungszeichen in den eckigen Klammern.

Hallo,

... auch ich habe aufgegeben, mich durch den Code zu quälen.

Danke, Berni

Vielen Dank für die schnellen Antworten und sorry für die Unübersichtlichkeit. Eure Tipps haben mir direkt geholfen das Problem weiter einzugrenzen.

Wenn ich über

Code:
shcount = wbPro.Worksheets.Count

die Reiter durchzählen lasse, wie kann ich ihm dann sagen das er im 2. Reiter etwas auswählen soll?

Code:
Worksheets(2).Range("A7:H22").Select

    Selection.Copy

Das funktioniert nur wenn ich mich bereits im 2. Reiter befinde.

Vielen Dank für eure Hilfe!

Grundsätzlich sollte man auf .Select verzichten, weil es unnötig ist und damit einfach nur der Cursor durch die Mappe gejagt wird. Um deine Frage trotzdem zu beantworten - aktiviere das jeweilige Sheet zuerst

Code:
Worksheets(2).Activate

Worksheets(2).Range("A7:H22").Select

    Selection.Copy

Aber wie erwähnt, lass das lieber. Das geht weit eleganter, zB über

Code:
Sheets(2).Range("A7:H22").Copy Destination:=Sheets("DeinBlatt").Range("A5")

oder

Code:
Sheets("DeinBlatt").Range("A5:H20").Value = Sheets(2).Range("A7:H22").Value

Vielen dank für den Tipp für die elegantere Varianten.
Hab es versucht umzusetzen, da aber auch davor schon nicht funktioniert hat das kopierte in eine andere Datei zu schreiben hat dein Ansatz auch nicht geklappt.

Code:
' DIM DES ZIELS ALS ARBEITSMAPPE

Dim wbZiel As Workbook

' DIM DES ZIELS ALS ARBEITSBLATT

Dim wSZiel As Worksheet

' DIESE ARBEITSMAPPE ALS ZIEL FESTLEGEN

Set wbZiel = ThisWorkbook

Set wSZiel = wbZiel.Worksheets(1)

Damit habe ich versucht meine Datei aus der ich das Makro starten möchte als Ziel festzulegen.

Code:
Sheets(wSZiel).Range("A5:H20").Value = Sheets(2).Range("A7:H22").Value

Hallo,

wir wären wahrscheinlich schon um Einiges weiter, wenn Du statt uns irgendwelche Knochenteile mal endlich den
gesamten Code zeigen würdest.
Ich habe absolut keinen Bock drauf, Stückchen für Stückchen jeweils den benötigten Code anfordern zu müssen.

Hallöchen,

Sheets(wSZiel).Range("A5:H20").Value = Sheets(2).Range("A7:H22").Value

Wenn Du das Makro startest, wenn die Datei aktiv ist, wo es drin steht, dann ist auch das Quellblatt in dieser Datei.
Soll das Quellblatt aus einer anderen Datei sein, müsstest Du entweder sicherstellen, dass beim Durchlauf dieser Befehlszeile die Quelldatei aktiv ist, oder Du musst die Quelle ähnlich dem Ziel im Code verdrahten.

(04.07.2018, 16:46)Käpt\n Blaubär schrieb: [ -> ]Hallo,

wir wären wahrscheinlich schon um Einiges weiter, wenn Du statt uns irgendwelche Knochenteile mal endlich den
gesamten Code zeigen würdest.
Ich habe absolut keinen Bock drauf, Stückchen für Stückchen jeweils den benötigten Code anfordern zu müssen.

Zunächst wurde mir ja gesagt, dass es zu anstrengend ist sich durch den kompletten Code zu arbeiten. Außerdem habe ich den ja größtenteils aus dem Internet kopiert und füge aktuell nur Stück für Stück hinzu was ich benötige (viel trial and error Blush

)
Ich versuche jetzt mal den Code zu entrümpel dann poste ich ihn nochmal.

Zunächst mal der Teil der mMn funktioniert. Zumindest das auswählen und öffnen der Dateien. Ob ich bei den dims alles richtig habe weiß ich nicht genau:

Code:

Code:
ub Workbook_Open()

' BILDSCHIRMAKTUALISIERUNG (ANZEIGE) AUS!

'Application.ScreenUpdating = False

' DIM DER PROJEKTE ALS ARBEITSMAPPEN

Dim wbPro As Workbook

' DIM DES ZIELS ALS ARBEITSMAPPE

Dim wbZiel As Workbook

' DIM DES ZIELS ALS ARBEITSBLATT

Dim wSZiel As Worksheet

' DIM DER ANZAHL DER IN DEN PROJEKTEN ENTHALTENEN BLÄTTER

Dim shcount As Integer

' DIESE ARBEITSMAPPE ALS ZIEL FESTLEGEN

Set wbZiel = ThisWorkbook

Set wSZiel = wbZiel.Worksheets(1)

' DIMs FÜR DIE DATEIAUSWAHL

Dim filenames, f

    Dim x As Integer

    Dim myMsg As String

    ' DATEIDIALOG IM PFAD DIESER MAPPE ÖFFNEN

    ChDir ThisWorkbook.Path

    ' filenames = DIE NAMEN DER AUSGEÄHLTEN PROJEKTE

    filenames = Application.GetOpenFilename(FileFilter:="Excel VBA files (*.xls*), *.xls*", _

                                            FilterIndex:=1, _

                                            Title:="Bitte wähle die Projekte aus!", _

                                            MultiSelect:=True)

    ' WENN filenames NAMEN ENTHÄLT (>0) DANN IST X DIE ANZAHL

    If IsArray(filenames) Then

        x = UBound(filenames) - LBound(filenames) + 1

        myMsg = "Du hast " & x & " Projekte ausgewählt."

        'Display full path and name of the files

        MsgBox myMsg

    Else

        MsgBox "Du hast keine Projekte ausgewählt!"

        Exit Sub

    End If

'######################################

'# BEGINN DES LOOPS durch die Dateien #

'######################################

' f IST DER DATEINAME, ALSO NACHFOLGENDER CODE WIRD FÜR JEDE DATEI DURCHLAUFEN

For Each f In filenames

    ' "wbPro" IST NUN DIE DATEI MIT DEM NAMEN AUS "f"; DIESE WIRD GEÖFFNET

    Set wbPro = Workbooks.Open(Filename:=f)

    ' ZÄHLUNG DER VORHANDENEN ARBEITSBLÄTTER IN "wbPro"

    shcount = wbPro.Worksheets.Count

Nun ist das Arbeitsblatt aus dem ich etwas kopieren und in das Mastersheet (in dem ich das Makro starte) offen.

Ich hatte ein paar schönere Ansätze aber die wollten einfach nicht funktionieren. Habe das ganze jetzt mal unschön gemacht, aber dafür macht es für diesen speziellen Fall was er machen soll.

Code:

Code:
'

 Sheets(2).Activate

    Range("A7:H22").Select

    Selection.Copy

Windows("AOK(18).xlsx").Activate

    'Variablendeklaration

    Dim Zelle, I

    'For-Next-Schleife sucht nächste freie Zelle

For I = 2 To 1000000

    If Range("A" & I) = "" Then

        Zelle = "A" & I

        Exit For

    End If

Next I

    'Jetzt Menge in die Zelle schreiben

    Range(Zelle).Select

    ActiveSheet.Paste

' AKTUELLE DATEI SCHLIESSEN, OHNE SIE ZU SPEICHERN!

wbPro.Close False

'######################################

'#           NÄCHSTE DATEI            #

'######################################

Next f

' BILDSCHIRMAKTUALISIERUNG (ANZEIGE) WIEDER AN!

Application.ScreenUpdating = True

'######################################

'#               FERTIG               #

'######################################

End Sub

Seiten: 1 2

KBKK

MisterBurns

Käpt'n Blaubär

KBKK

MisterBurns

KBKK

Käpt'n Blaubär

schauan

KBKK

KBKK