2.9k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo

Kann man den folgenden Code ändern?

1. nur eine bestimmter bereich soll kopiert werden und in den Zielort in der selben
stelle eingefügt werden. (z.B: $A:$G)

2. Zielort soll das aktuelle Tabellenblatt sein ..



Option Explicit

Sub Datenimport()
Dim Importdatei$, Verzeichnis$, aktiver_Blattname As String
Application.ScreenUpdating = False
aktiver_Blattname = ActiveSheet.Name
Sheets("C-1012").Activate
Cells.ClearContents
Verzeichnis = "C:\"
On Error Resume Next
ChDir Verzeichnis
Importdatei = Application.GetOpenFilename("Exceldateien (*.csv), *.csv")
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Importdatei, _
Destination:=Range("A1"))
.TextFileSemicolonDelimiter = True
.Refresh BackgroundQuery:=False
End With
Sheets(aktiver_Blattname).Activate
End Sub

13 Antworten

0 Punkte
Beantwortet von beverly Experte (3.5k Punkte)
Hi,

hast du eine eigene Homepage oder z.B. DropBox?

Bis später,
Karin
0 Punkte
Beantwortet von
Hallo

unter folgenden Link habe ich drei Dateien hochgeladen.

https://www.dropbox.com/sh/hli11q4tg5iiqoz/AADjw3p-
Z7WqN7E8q8sQApRea

1. orginal.csv
2. geöffnet mit Excel (so hätte ich gerne gehabt)
3.druch makro (mit hilfe der o.g. makro eingefügt)


vielen Dank im Voraus
0 Punkte
Beantwortet von nuro1 Einsteiger_in (11 Punkte)
Jetzt klappt...

Ich bedanke mich viele male..

Der Code wird mir sehr viel arbeit ersparen...

Für alle die auch daran interessiert sind.


Sub Datenimport()
Dim Importdatei$
Application.ScreenUpdating = False
With ActiveSheet
Importdatei = GetFile
Workbooks.Open Filename:=Importdatei, Local:=True
Range("A:F").Copy .Range("A1")
ActiveWorkbook.Close False
End With
Application.ScreenUpdating = True
End Sub

Function GetFile() As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialFileName = "C:\"
.ButtonName = "OK"
.Filters.Add "Textdateien", "*.csv", 1
.Title = "Dateiauswahl"
.Show
If .SelectedItems.Count = 0 Then
GetFile = ""
Else
GetFile = .SelectedItems(1)
End If
End With
End Function
...