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