Problem beim txt zusammenführen mit Makro
26.06.2016 10:29:19
Mirjam
ich möchte mit einem VBA-Code folgendes Ziel erreichen:
- mehrere txt-Dateien auf einmal in Excel einlesen
- Inhalt der txt-Dateien (mehrere Spalten) in ein gemeinsames Tabellenblatt schreiben
- Inhalt der txt-Dateien nebeneinander anordnen
Ich habe dazu einen Code im Internet gefunden, der ursprünglich für folgendes Ziel geschrieben war:
- Einlesen und Zusammenführen mehrerer xls
- Inhalte der xls untereinander angeordnet
Mittlerweile konnte ich den Code so modifzieren, dass er für die spaltenweise Anordnung der Dateien funktioniert. Allerdings werden durch Anwenden des Programm-Codes, die Kommazahlen ab einem Wert größer 1 nicht mehr als Zahl erkannt. Könnt ihr mir helfen und mir einen Tipp geben, was ich noch ändern muss?
Vielen Dank! Ich wünsche einen sonnigen Sonntag...
Option Explicit
Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
'Code für ein allgemeines Modul
'Autor: Jürgen Hennekes
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Dim lngRightQ As Long
Dim lngInc As Long
Dim RngToCopy As Range
Dim DestCell As Range
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
WBZ.Worksheets(1).Range("A1:IV65536").ClearContents
varDateien = _
Application.GetOpenFilename("Datei (*.txt),*.txt", False, "Bitte gewünschte Datei(en) markieren" _
_
, False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
lngInc = 0
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
lngRightQ = WBZ.Worksheets(1).Cells(40, Columns.Count).End(xlToLeft).Column
lngLastQ = WBQ.Worksheets(1).Range("E65536").End(xlUp).Row
If lngAnzahl > 1 Then lngInc = 2
Set RngToCopy = WBQ.Worksheets(1).Range("A1:Z" & lngLastQ)
Set DestCell = WBZ.Worksheets(1).Cells(1, lngRightQ + lngInc)
DestCell.Resize(RngToCopy.Rows.Count, RngToCopy.Columns.Count).Value = _
RngToCopy.Value
WBQ.Close
'WBZ.Worksheets(1).Range(Cells(35, lngRightQ + lngInc + 10), Cells(lngLastQ, lngRightQ + lngInc _
_
+ 10)).Value = WBZ.Worksheets(1).Range(Cells(35, lngRightQ + lngInc + 3), Cells(lngLastQ, _
lngRightQ + lngInc + 3)).Value / WBZ.Worksheets(1).Range(Cells(35, lngRightQ + lngInc + 2), Cells(lngLastQ, lngRightQ + lngInc + 2)).Value
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If
End Sub