Werte aus anderem Excelblatt kopieren
#1
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
Top
#2
Hallo,
die entsprechende Zeile könnte so aussehen:

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

Gruß Günter
Top
#3
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?
Top
#4
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?
Top
#5
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.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • DeLaGhetto
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste