PasteSpecial funktioniert nicht
Chritian
Leider hat das Makro einen kleinen Schönheitsfehler: Von den Werten, welche aus den externen Excel-Dateien in die eigene Tabelle kopiert werden, kann keine Summe gebildet werden.
Das Problem lässt sich lösen, wenn statt einem gewöhnlichen Paste ein PasteSpecial Paste:=xlPasteValues verwendet wird.
Offenbar kann ich aber nicht die Worksheet.PasteSpecial-Methode verwenden, sondern muss auf die Range.PasteSpecial-Methode ausweichen.
Ich habe alles mögliche versucht und das Script verschiedentlich angepasst, aber habe es einfach nicht hingekriegt. Ein Problem scheint zu sein, dass beim Wechsel von einer Datei zur anderen, wo einfegügt werden soll, das Clipboard seinen Inhalt verliert... oder so ähnlich.
Hat jemand einen Tipp, wie ich da hinkriegen könnte.
Option Explicit
Option Compare Text
Sub zusammensetzen()
Dim i
Dim myfolder
Dim mytabelle
Dim myrange
Dim mylines
Dim offset
Dim myfilename
Dim fso As Object
Dim fol As Object
Dim fil As Object
'Where you define what to "zusammensetzen"
myfolder = Range("D4") 'Pfad zu den Arbeitsrapporten
mytabelle = Range("D6") 'Name der zu bearbeitenden Tabelle
myrange = Range("D9") 'Bereich in der Tabelle, welcher kopiert werden soll ( _
Feldwert(e)):
mylines = Range(myrange).Rows.Count 'zum Berechnen der Zeile zum nächsten Einfügen
offset = Range("D11") 'Position, bei welcher mit Einfügen begonnen werden soll
i = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder(myfolder)
For Each fil In fol.Files
i = i + 1
Workbooks.Open Filename:=fil
myfilename = Right(fil, Len(fil) - Len(myfolder))
Sheets(mytabelle).Activate
Range(myrange).Copy
ActiveWorkbook.Close False
ActiveSheet.Paste Destination:=Worksheets("Auswertung").Range(offset).offset(i * mylines - _
mylines, 1)
Worksheets("Auswertung").Range(offset).offset(i * mylines - mylines).Value = myfilename
Next fil