jerry0110
Erfahrenes Mitglied
Hallo zusammen,
ich habe mal wieder eine Herausforderung.
Ich habe eine CSV die ich in eine Excel kopiere.
Er übernimmt auch die Daten und es klappt auch so gut wie alles.
Aber das Datum wird so übernommen, dass ich theoretisch mit F2 in die Zelle gehen und dann Enter drücken muss, damit das dann auch als Datum deklariert wird.
ich habe mal wieder eine Herausforderung.
Ich habe eine CSV die ich in eine Excel kopiere.
Er übernimmt auch die Daten und es klappt auch so gut wie alles.
Aber das Datum wird so übernommen, dass ich theoretisch mit F2 in die Zelle gehen und dann Enter drücken muss, damit das dann auch als Datum deklariert wird.
Code:
Sub xCopy3()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim QWB As Workbook, ZWB As Workbook
Workbooks.Open "\\oda-san1\Auswertung_Report_JLI.xlsx"
Set QWB = Workbooks("Auswertung_Report_JLI.xlsx")
Set ZWB = Workbooks("Aktionsbericht_Neu.xls") ' Ziel, Workbook mit diesem Makro
Dim QWS As Worksheet, ZWS As Worksheet
Set QWS = QWB.Worksheets("Tabelle1") ' Quelle
Set ZWS = ZWB.Worksheets("SQL-Ergebnisse") ' Ziel
QWS.Cells.Copy ZWS.Cells(1, 1) ' Inhalt in Ziel-Tabelle einfügen
Workbooks("Auswertung_Report_JLI.xlsx").Close
Kill ("\\oda-san1\Auswertung_Report_JLI.xlsx")
Kill ("\\oda-san1\Auswertung_Report_JLI.csv")
Application.EnableEvents = True
End Sub
Sub CSV()
Dim sFile As String, sPath As String, iFree As Integer
Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
Dim zFile As String
Dim myDate As Date
sPath = "\\oda-san1\" 'anpassen
sFile = Dir(sPath & "*.csv")
zFile = "Auswertung_Report_JLI"
Application.ScreenUpdating = False
Do While Len(sFile)
iFree = FreeFile
Open sPath & sFile For Input As iFree
arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
Close iFree
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
n = Application.Max(n, UBound(arrTmp))
Next
ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
For j = 0 To UBound(arrTmp)
arrXLS(i + 1, j + 1) = arrTmp(j)
Next
Next
With Workbooks.Add
.Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
.SaveAs sPath & Mid(zFile, 1, Len(sFile) - 4)
.Close
End With
sFile = Dir
Loop
xCopy3
ThisWorkbook.Sheets("Agenturbericht").Range("H7").Value = Date
ThisWorkbook.Sheets("SQL-Ergebnisse").Range("B:B").NumberFormat = "dd.mm.yy;@"
End Sub
Zuletzt bearbeitet: