Hallo Holger,
deine E-Mail-Adresse wurde leider nicht übertragen, so dass ich diesen Weg wieder wählen muss.
Deine Vorlage, in die die Tabelle hinein kopiert werden soll, kenne ich nicht, so dass ich mich auf die Erzeugung der umsortierten Tabelle konzentriere. Dazu habe ich in deinem Programm einige Zeilen zum Kommentar verändert, weil ich sie wegen nicht vorhandener Arbeitsmappen nicht verwenden kann, und am Programmende einige Zeilen eingefügt, die die gewünschte Tabelle auf dem Blatt "Neu" in den Feldern A1 bis D25 erzeugen. Wenn du diese Tabelle in deine Vorlage kopieren willst, kannst du sie mit
Sheets("Neu").Select
Range("A1:D25").Select
Selection.Copy
in die Zwischenablage kopieren und mit geeigneten Befehlen, die du durch das Aufzeichnen eines Makros leicht finden kannst, an der gewünschte Stelle einfügen.
Ich hoffe, dir etwas geholfen zu haben
Holger
Das veränderte Programm, wobei du einige Kommentare wieder in Befehle zurücksetzen musst, um die Tabelle in der richtigen Arbeitsmappe zu erzeugen.
Dim CSV_Datei As Variant, DateiNeu As Variant, PfadCSV As String, Blattname As String
' Öffnen der CSV-Datei
CSV_Datei = Application.GetOpenFilename( _
fileFilter:="CSV Datei (*.*), *.*")
If CSV_Datei <> False Then
'Application.Workbooks.OpenText CSV_Datei, , , , , , , Semicolon, Comma
'PfadCSV = ActiveWorkbook.Path 'Pfad der CSV-Dateien
Else
MsgBox "Vorgang wurde abgebrochen!"
Exit Sub
End If
' Makro am 19.10.2007 von scipioh aufgezeichnet
' Umwandlung der CSV Datei in eine Excel Tabelle
Workbooks.OpenText Filename:=CSV_Datei, _
Origin:=xlWindows, StartRow:=3, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True _
, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1) _
, Array(2, 1))
ActiveSheet.Name = "Silke"
'Workbooks("CSWERT464_0006_.xls").Activate
'Worksheets("Silke").UsedRange.Copy
'Workbooks("Protokoll Kontamination.xls").Worksheets("Protokoll").Activate
Set NewSheet = Worksheets.Add
'NewSheet.Range("A1").PasteSpecial Paste:=xlValues
'ActiveSheet.Name = "Silke"
'Kopiere Werte
' Workbooks("Protokoll Kontamination.xls").Worksheets("Protokoll").Activate
'MsgBox Protokoll.Cells(3, 2)
'Wechselt in die Ansicht Protokoll
' Workbooks("Protokoll Kontamination.xls").Worksheets("Protokoll").Activate
' Speichern der Datei als EXCEL-Arbeitsmappe
' DateiNeu = Application.GetSaveAsFilename( _
' fileFilter:="Excel Arbeitsmappe (*.xls), *.xls")
' If DateiNeu <> False Then
' ActiveWorkbook.SaveAs DateiNeu, xlWorkbookNormal
' Else
' MsgBox "Vorgang wurde abgebrochen!"
' Exit Sub
' End If
' DateiNeu = ActiveWorkbook.Name
'Umsortierung der Zellen
ActiveSheet.Name = "Neu"
Worksheets("Neu").Range("b2:b25").Value = Worksheets("Silke").Range("b7:b31").Value
Worksheets("Neu").Range("c2:c25").Value = Worksheets("Silke").Range("b32:b56").Value
Worksheets("Neu").Range("d2:d25").Value = Worksheets("Silke").Range("b57:b81").Value
Worksheets("Neu").Activate
Cells(1, 2) = "CS_4um"
Cells(1, 3) = "CS_6um"
Cells(1, 4) = "CS_14um"
For i = 1 To 24
Cells(i + 1, 1) = "[" + Trim(Str(i)) + "]"
Next i
|