Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1680to1684
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Externe Werte in Sammeldatei kopieren

Externe Werte in Sammeldatei kopieren
18.03.2019 11:17:38
Alex
Guten Tag,
um mir auf der Arbeit Zeit zu ersparen, habe ich mir einen Tag genommmen, um ein Makro zusammenzubasteln.
Folgende Datei habe ich:
https://www.herber.de/bbs/user/128463.xlsx
Im Prinzip habe ich eine Liste, in die ich Messwerte täglich kopieren muss.
Da es mehrere Listen und Messreihen sind, erspart mir ein Makro wertvolle Zeit.
Das Makro öffnet eine Externe Datei und kopiert sich daraus die Zeilen ab Spalte X.
Diese Werte sollen in die Sammelliste eingefügt werden.
Diese sollen in die erstmögliche Zeile ab Spalte Y eingefügt werden.
Leider fügt mein Code die Werte nicht in die richtige Zeile ein (wo das akutelle Datum steht), sondern unter der kompletten Tabelle.
Zusätzlich muss manchmal eine 2. Datei kopiert werden. Diese überschreiben aber die Werte aus der 1. Kopie.
Es ist schwer zu erklären, deswegen ist in der Datei eine Anschauung, wie es aussehen sollte.
Hier mein Code

  • Option Explicit
    
    Sub Messwerte()
    Dim wsZiel As Worksheet
    Dim wsQuelle As Worksheet
    Dim rng As Range
    Dim rngZeile As Range
    Const Spalten = 80                                                  '80 Spalten beachten
    Const Spalte1 = 3                                                   'Bei Spalte 3 beginnen
    Dim lRow As Long
    Dim strName1 As String
    Dim strName2 As String
    Dim Datum As String
    Datum = Format(Date, "YYYY.MM.DD")
    strName1 = "D:\Dokumente\Messreihen\" & Datum & " _ Reihe1 - Anlage1 - teil1.csv"
    strName2 = "D:\Dokumente\Messreihen\" & Datum & " _ Reihe1 - Anlage1 - teil2.csv"
    'Zielblatt = aktive Datei, aktives Blatt
    Set wsZiel = ActiveWorkbook.Worksheets(2)
    'Quellblatt = Datei, Blatt 1
    Set wsQuelle = Workbooks.Open(Filename:=strName1, Local:=True).Worksheets(1)
    'Kopieren
    With wsQuelle
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
    .Cells(1, Spalte1).Resize(lRow, Spalten - Spalte1 + 1).Copy
    End With
    With wsZiel
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row + 1
    .Cells(lRow, 23).PasteSpecial
    End With
    'Zwischenspeicher löschen
    Application.CutCopyMode = False
    'Quelle schließen
    wsQuelle.Parent.Close
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
    'Teil 2 einfügen
    If Dir(strName2)  "" Then
    Set wsZiel = ActiveWorkbook.Worksheets(2)
    Set wsQuelle = Workbooks.Open(Filename:=strName2, Local:=True).Worksheets(1)
    'Kopieren
    With wsQuelle
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
    .Cells(1, Spalte1).Resize(lRow, Spalten - Spalte1 + 1).Copy
    End With
    With wsZiel
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row + 1
    .Cells(lRow, 23).PasteSpecial
    End With
    Application.CutCopyMode = False                                 'Zwischenspeicher löschen
    'Quelle schließen
    wsQuelle.Parent.Close
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
    End If
    End Sub
    


  • Vielen Dank im Voraus für Lösungsvorschläge

    8
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Ziel setzen
    18.03.2019 11:31:29
    Fennek
    Hallo,
    ungeprüft: anstelle von:
    
    With wsZiel
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row + 1
    .Cells(lRow, 23).PasteSpecial
    End
    sollte es:
    lrow = .cells(.rows.count, "M").end(xlup).row + 1
    
    mfg
    AW: Ziel setzen
    18.03.2019 11:48:26
    Alex
    Hallo,
    Danke für die Antwort, leider kommt es aufs selbe hinaus.
    Die Werte landen in der Richtigen Spalte, werden aber am Ende eingefügt, also nach dem 31.12.2019,
    statt am 18.03.2019. Die Spalte stimmt, aber die Zeile nicht.
    Es soll ja in die 1. freie Zeile eingesetzt werden. :)
    Die 2. Datei wird zudem auch nicht hinter der Ersten eingefügt, sondern darunter.
    Irgenwie muss ich dann dort ja die Spalten ab dem 1. Messwert zählen und ab der ersten freien Zelle Teil 2 einsetzen oder? Wie setze ich das am besten um?
    Gruß, Alex
    Anzeige
    AW: Ziel setzen
    18.03.2019 11:54:17
    Alex
    Haken vergessen :/
    AW: Ziel setzen
    18.03.2019 13:02:06
    Daniel
    Ohne Beispieldatei wird es ziemlich schwierig, dein Problem nachzuvollziehen und unmöglich, Lösungen zu testen. Also bitte...
    Gruß
    Daniel
    AW: Ziel setzen
    18.03.2019 15:51:27
    Alex
    Fürwahr, die Datei im Eröffnungspost war etwas mager,
    der Code: https://www.herber.de/bbs/user/128475.txt
    Die Datei (Originalformatierung + Anschauung): https://www.herber.de/bbs/user/128476.xlsx
    Ich habs mittlerweile hingekriegt, an die richtige Position einzufügen, allerdings überschreibt der Code immer wieder die Werte.
    Ich habe überlegt dies mit dem Befehl "Suche die erste Freie Zelle im Bereich" zu realisieren
    
    Set Bereich = Range("W3:W520")
    For Each Zelle In Bereich
    If Zelle.Value = "" Then
    
    Damit würde ich das Problem beheben, ich krieg es aber noch nicht umgesetzt :/.
    Außerdem Werden Messwerte aus der zweiten Datei nicht hinter die Werte aus Datei eingefügt, sondern ersetzen diese. Dafür habe ich noch keine Lösung.
    Herzlichst,
    Alex
    Anzeige
    AW: Ziel setzen
    18.03.2019 15:51:29
    Alex
    Fürwahr, die Datei im Eröffnungspost war etwas mager,
    der Code: https://www.herber.de/bbs/user/128475.txt
    Die Datei (Originalformatierung + Anschauung): https://www.herber.de/bbs/user/128476.xlsx
    Ich habs mittlerweile hingekriegt, an die richtige Position einzufügen, allerdings überschreibt der Code immer wieder die Werte.
    Ich habe überlegt dies mit dem Befehl "Suche die erste Freie Zelle im Bereich" zu realisieren
    
    Set Bereich = Range("W3:W520")
    For Each Zelle In Bereich
    If Zelle.Value = "" Then
    
    Damit würde ich das Problem beheben, ich krieg es aber noch nicht umgesetzt :/.
    Außerdem Werden Messwerte aus der zweiten Datei nicht hinter die Werte aus Datei eingefügt, sondern ersetzen diese. Dafür habe ich noch keine Lösung.
    Herzlichst,
    Alex
    Anzeige
    AW: Ziel setzen
    18.03.2019 16:19:29
    Daniel
    Sorry, hatte übersehen dass du schon eine Datei hochgeladen hattest. Hoffe, ich habe die Problematik einigermaßen verstanden...
    Eine Lösung könnte sein, so wie ich das Problem verstehe (wobei ich deine externen Pfade durch Verweise innerhalb der Mappe wie in deinem Beispiel ersetzt habe):
    Sub Messwerte2()
    Dim wsZiel As Worksheet
    Dim wsQuelle As Worksheet
    Dim rng As Range
    Dim rngZeile As Range
    Const Spalten = 80                                                  '20 Spalten beachten
    Const Spalte1 = 3                                                   'Bei Spalte 1 beginnen
    Dim lRow, lCol, lColZiel As Long
    Dim strName1 As String
    Dim strName2 As String
    Dim Datum As String
    Datum = Format(Date, "YYYY.MM.DD")
    'strName1 = "D:\Dokumente\Messwerte\" & Datum & " _ Anlage1 - Reihe1 - teil1.csv"
    'strName2 = "D:\Dokumente\Messwerte\" & Datum & " _ Anlage1 - Reihe1 - teil2.csv"
    'Zielblatt = aktive Datei, aktives Blatt
    Set wsZiel = ActiveWorkbook.Worksheets(1)
    'Quellblatt = Datei, Blatt 1
    Set wsQuelle = ActiveWorkbook.Worksheets(2)
    'Kopieren
    With wsQuelle
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
    lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    .Cells(1, Spalte1).Resize(lRow, lCol).Copy
    End With
    With wsZiel
    lRow = .Cells(.Rows.Count, "W").End(xlUp).Row + 1
    .Cells(lRow, 23).PasteSpecial
    lRow = .Cells(.Rows.Count, "W").End(xlUp).Row
    lColZiel = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    End With
    'Zwischenspeicher löschen
    Application.CutCopyMode = False
    'Quelle schließen
    '    wsQuelle.Parent.Close
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
    'Teil 2
    If Dir(strName2)  "" Then
    'Zielblatt = aktive Datei, aktives Blatt
    Set wsZiel = ActiveWorkbook.Worksheets(1)
    'Quellblatt = Datei, Blatt 1
    Set wsQuelle = ActiveWorkbook.Worksheets(3)
    'Kopieren
    With wsQuelle
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
    lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    .Cells(1, Spalte1).Resize(lRow, lCol).Copy
    End With
    With wsZiel
    lRow = .Cells(.Rows.Count, lColZiel + 1).End(xlUp).Row + 1
    .Cells(lRow, lColZiel + 1).PasteSpecial
    End With
    End If
    'Zwischenspeicher löschen
    Application.CutCopyMode = False
    'Quelle schließen
    '    wsQuelle.Parent.Close
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
    End Sub
    
    Im Prinzip habe ich nichts anderes gemacht, als nicht nur die letzte Zeile, sondern auch die letzte Spalte zu ermitteln und diese anstatt der festen Werte für Teil 2 zu verwenden. Schau mal ob das hilft.
    Gruß
    Daniel
    Anzeige
    AW: Ziel setzen
    19.03.2019 09:08:11
    Alex
    Hallo Daniel,
    mit ein Paar Änderungen klappt der Code. Ich habe noch einen Bereich eingefügt, in dem operiert werden soll, da einige Spalten weiter hinten weitere Berechnungen sind.
    
    Sub Messwerte2()
    Dim wsZiel As Worksheet
    Dim wsQuelle As Worksheet
    Dim Bereich As Range
    Set Bereich = Range("A1:DG520")
    Dim rng As Range
    Dim rngZeile As Range
    Const Spalten = 80                                                  '20 Spalten beachten
    Const Spalte1 = 3                                                   'Bei Spalte 1 beginnen
    Dim lRow, lCol, lColZiel As Long
    Dim strName1 As String
    Dim strName2 As String
    Dim Datum As String
    Datum = Format(Date, "YYYY.MM.DD")
    'strName1 = "D:\Dokumente\Messwerte\" & Datum & " _ Anlage1 - Reihe1 - teil1.csv"
    'strName2 = "D:\Dokumente\Messwerte\" & Datum & " _ Anlage1 - Reihe1 - teil2.csv"
    'Zielblatt = aktive Datei, aktives Blatt
    Set wsZiel = ActiveWorkbook.Worksheets(1)
    'Quellblatt = Datei, Blatt 1
    Set wsQuelle = ActiveWorkbook.Worksheets(2)
    'Kopieren
    With wsQuelle
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
    lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    .Cells(1, Spalte1).Resize(lRow, lCol).Copy
    End With
    With wsZiel
    With Bereich
    lRow = .Cells(.Rows.Count, "W").End(xlUp).Row + 1
    .Cells(lRow, 23).PasteSpecial
    lRow = .Cells(.Rows.Count, "W").End(xlUp).Row
    lColZiel = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    End With
    End With
    'Zwischenspeicher löschen
    Application.CutCopyMode = False
    'Quelle schließen
    '    wsQuelle.Parent.Close
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
    'Teil 2
    If Dir(strName2)  "" Then
    'Zielblatt = aktive Datei, aktives Blatt
    Set wsZiel = ActiveWorkbook.Worksheets(1)
    'Quellblatt = Datei, Blatt 1
    Set wsQuelle = ActiveWorkbook.Worksheets(3)
    'Kopieren
    With wsQuelle
    lRow = .Cells(.Rows.Count, Spalte1).End(xlUp).Row
    lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    .Cells(1, Spalte1).Resize(lRow, lCol).Copy
    End With
    With wsZiel
    With Bereich
    lRow = .Cells(.Rows.Count, lColZiel + 1).End(xlUp).Row + 1
    .Cells(lRow, lColZiel + 1).PasteSpecial
    End With
    End With
    End If
    'Zwischenspeicher löschen
    Application.CutCopyMode = False
    'Quelle schließen
    '    wsQuelle.Parent.Close
    Set wsQuelle = Nothing
    Set wsZiel = Nothing
    End Sub
    

    Ich versuche wenn ich mal wieder Zeit hab, alles etwas zu verfeinern.
    
    With wsZiel
    With Bereich
    lRow = .Cells(.Rows.Count, "W").End(xlUp).Row + 1
    .Cells(lRow, 23).PasteSpecial
    lRow = .Cells(.Rows.Count, "W").End(xlUp).Row
    lColZiel = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
    End With
    End With
    
    Hier will ich im Zielbereich direkt die erste freie Zelle suchen, damit das händische eintragen der Spalte wegfällt. Dann kann ich das direkt auf andere Dateien anwenden, ohne immer die Spalten rauszusuchen. Das versuche ich aber erstmal selbst :)
    Danke für die Hilfe!
    MfG Alex
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige