Clever-Excel-Forum

Hallo zusammen,
ich bins nochmal Smile

Diesmal habe ich folgendes Problem:
Ich möchte in meine Excel Datei ein paar Werte aus einer anderen Datei einlesen, ohne die andere Datei dabei zu öffnen. Auf der Suche nach einem Code bin ich auf folgenden Code gestoßen, der auch funktioniert:

Code:
Sub kopieren()

  'Bitte den Name deiner Datei anpassen!

  Workbooks.Open "C:\Users\ivkalatc\Desktop\2017_10_09_Vorschlag Plan_.xlsm"

  With Range("C8:C15")

    .Copy _

      Destination:=Workbooks("Mappe1").Sheets("Tabelle1").Range("A1")

  End With

  Workbooks("2017_10_09_Vorschlag Plan_.xlsm").Close SaveChanges:=False

End Sub

Allerdings habe ich mit dem code folgendes Problem:
1. Ist es möglich, dass ich den Pfad der zu kopierenden Datei aus einer Zelle in der Mappe1 auslese?
2. Der Code kopiert mir alles mit, das heißt Formatierung usw. Ich möchte allerdings nur die Werte an sich in der Mappe1 haben.

Kann man das so machen?

Danke schon im Vorraus

Hallo,
die entsprechende Zeile könnte so aussehen:

Code:
Workbooks.Open ActiveSheet.Range("B3") & "\2017_10_09_Vorschlag Plan_.xlsm"

Gruß Günter

Aber das heißt, dass sich der Name der Tabelle nicht ändern darf, oder?

Könnte man das dann so machen, dass wenn ich auf das Makro klicke, mir automatisch das "öffnen" Menü eingeblendet wird, und ich die Datei händisch auswähle?

Hallo nochmal,

Entschuldigung das ich so oft meine Aufgabenstellung ändere...

Ich habe jetzt folgenn Code im Internet gefunden, der auch perfekt funktioniert:

Code:
Sub Oeffnen_und_kopieren()

    Dim Datei As Variant

    Dim Quelle, Ziel As String

    Dim bExists, MappeOffen As Boolean

    Dim i As Integer

    Dim lZeile As Long

    Dim Rückgabe

    'Datei-Öffnen Dialog aufrufen

    Datei = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xl*), *.xl*", Title:="EINE Datei zum Öffnen auswählen")

    If Datei = False Then

        'Makro abbrechen wenn Benutzer den Öffnen-Dialog abbricht

        MsgBox "Der Benutzer hat abgebrochen.", vbInformation

        Exit Sub

    End If

    'Prüfen, ob Datei schon offen ist

     For i = 1 To Workbooks.Count

        If Workbooks(i).FullName = Datei Then

            'ausgewählte Mappe ist bereits offen

            MappeOffen = True

            'Frage, ob Daten kopiert werden sollen

            Rueckgabe = MsgBox("Die Arbeitsmappe " & Quelle & " ist bereits offen! Sollen die Daten kopiert werden?", vbYesNo + vbQuestion, "Mappe bereits offen")

            'Abbruch des Makros

            If Rueckgabe = vbNo Then Exit Sub

            'Name der Quelldatei in Variable schreiben

            Quelle = Workbooks(i).Name

         End If

      Next i

     'Bildschirmaktualisierung ausschalten:

    Application.ScreenUpdating = False

    'ausgewählte Datei öffnen, falls diese noch nicht offen ist

    If MappeOffen = False Then

     Workbooks.Open (Datei)

     'Name der Quelldatei in Variable schreiben

     Quelle = ActiveWorkbook.Name

    End If

    'Name der Zielarbeitsmappe wird in Datei geschrieben

    Ziel = ThisWorkbook.Name

    'Prüfen, ob Tabellenblatt mit Namen Plan in Quelldatei existiert

    For i = 1 To Workbooks(Quelle).Sheets.Count

     If Workbooks(Quelle).Sheets(i).Name = "Plan" Then

      bExists = True: Exit For

     End If

    Next i

    'Abbruch des Makros falls kein Arbeitsblatt mit dem Namen Sheet1 existiert

    If bExists = False Then

     MsgBox "In der Arbeitsmappe " & Quelle & " existiert kein Arbeitsblatt mit dem Namen Plan! Abbruch!", 16, "Fehlermeldung"

     Exit Sub

    End If

    'Festlegen der Zeile zum Einfügen der Daten in Tabelle1

    lZeile = Workbooks(Ziel).Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

    'Prüfen, ob erste Zeile leer ist, falls ja, Zeilenzähler auf 1 setzen

    If Workbooks(Ziel).Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row = 1 Then

     If IsEmpty(Workbooks(Ziel).Sheets("Tabelle1").UsedRange) Then lZeile = 1

    End If

    'Kopieren der Daten - C8 wird nach Spalte A kopiert

    Workbooks(Quelle).Sheets("Plan").Range("C8").Copy

    Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 1).PasteSpecial Paste:=xlPasteValues    'Werte kopieren

    'C9 wird nach Spalte B kopiert

    Workbooks(Quelle).Sheets("Plan").Range("C9").Copy

    Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 2).PasteSpecial Paste:=xlPasteValues

    'C10 wird nach Spalte C kopiert

    Workbooks(Quelle).Sheets("Plan").Range("C10").Copy

    Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 3).PasteSpecial Paste:=xlPasteValues

    'C12 wird nach Spalte D kopiert

    Workbooks(Quelle).Sheets("Plan").Range("C12").Copy

    Workbooks(Ziel).Sheets("Tabelle1").Cells(lZeile, 4).PasteSpecial Paste:=xlPasteValues

    'Quelldatei schließen, wenn diese über das Makro geöffnet wurde

    If MappeOffen = False Then Workbooks(Quelle).Close

    'Meldung, dass Daten kopiert wurden

    MsgBox "Die Daten aus der Datei " & Quelle & " wurden kopiert!", 64, "Information"

    'Bildschirmaktualisierung einschalten:

    Application.ScreenUpdating = True

End Sub

Allerdings gibt es mit dem Code nur noch ein kleines, winziges Problem:
Der Code kopiert die gewünschten Zeilen aus der Quelldatei immer in die erste Zeile in A, den nächsten Wert in die erste Zeile in B usw.
Falls in der ersten Zeile etwas steht, dann kopiert er das in die Zeile da drunter usw.

Ich müsste aber Excel die genaue Zeile vorgeben, wohin er die Zeilen aus der Quelldatei in die Zieldatei schreiben soll.

Könnte mir da jemand auf die Sprünge helfen?

Hallöchen,

wenn Du im Code mal nach was mit Zeile suchst, findest Du u.a. das:

lZeile = Workbooks(Ziel).Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

der Code holt sich hier in die Variable lZeile irgendwas aus dem Blatt und zählt 1 dazu.
Ich würde dann mal nix aus dem Blatt holen lassen, sondern die gewünschte konkrete Zahl programmieren Smile

Anschliessend brauchst Du natürlich auch nicht mehr prüfen, ob die erste Zeile leer ist.

DeLaGhetto

gbr

DeLaGhetto

DeLaGhetto

schauan