AW: Seltsames Problem
21.07.2005 17:15:45
Timo
Sub Import()
Dim hauptfenster As String
Dim datenfenster As String
Dim lngCount As Long
Cells.Select
Selection.Clear
Range("A1").Select
hauptfenster = ActiveWorkbook.Name
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ActiveWorkbook.Path
.AllowMultiSelect = True
.Show
For lngCount = 1 To .SelectedItems.Count
Workbooks.OpenText Filename:=.SelectedItems(lngCount) _
, Origin:=437, StartRow:=6, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=True, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", _
TrailingMinusNumbers:=True
datenfenster = ActiveWorkbook.Name
Windows(datenfenster).Activate
ActiveWorkbook.Sheets("Akribismesswerte").Select
Application.CutCopyMode = False
ActiveWorkbook.ActiveSheet.Range("D22").Select
Selection.Copy
Windows(hauptfenster).Activate
ActiveWorkbook.ActiveSheet.Cells(lngCount + 1, 1).Select
Selection.Value = datenfenster
ActiveWorkbook.ActiveSheet.Cells(lngCount + 1, 3).Select
ActiveSheet.Paste
Windows(datenfenster).Activate
Worksheets("Timingparameter").Activate
Application.CutCopyMode = False
ActiveWorkbook.ActiveSheet.Range("H2").Select
Selection.Copy
Windows(hauptfenster).Activate
ActiveWorkbook.ActiveSheet.Cells(lngCount + 1, 2).Select
ActiveSheet.Paste
Windows(datenfenster).Activate
Application.CutCopyMode = False
ActiveWorkbook.ActiveSheet.Range("E22").Select
Selection.Copy
Windows(hauptfenster).Activate
ActiveWorkbook.ActiveSheet.Cells(lngCount + 1, 4).Select
ActiveSheet.Paste
Windows(datenfenster).Close
Next lngCount
End With
Columns("C:D").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
End Sub