mehrere zellbereiche importieren
15.02.2009 13:08:00
michael
ich habe einen nicht einwandfrei funktionierenden code:
aus einer datei "ursprungsdatei" (die im script über explorer ausgewählt wird) sollen bestimmte zellbereiche einer "tabelle 1" in eine importdatei per vba eingelesen werden.
die bereiche, die einzulesen sind, stehen in der importdatei in spalte A.
D.h. z.B. alle zellwerte e1 - e4 der ursprungsdatei sollen in der importdatei in e1 - e4 eingetragen werden.
Verknüpfungen scheiden im vorhinein aus.
Folgende Anweisung habe, die aber nicht alle zellbereiche einliest und imho nicht optimal funktioniert:
Code:
Sub Import()
Dim vFile As Variant
Dim iRow As Integer
Dim sPath As String, sFormula As String, sMem As String, sRange As String
sPath = "c:"
sMem = CurDir
ChDrive Left(sPath, 1)
ChDir sPath
vFile = Application.GetOpenFilename("Excel-Arbeitsmappen (*.xls), *.xls")
If vFile = False Then Exit
Sub
sFormula = "='" & sPath & "[" & Dir(vFile) & "]Tabelle1'!" & Range("A1").Value
With Worksheets("Import")
.Range(Range("A1").Value).FormulaLocal = sFormula
iRow = 2
Do Until IsEmpty(Cells(iRow, 1))
If iRow = 2 Then
sRange = Cells(iRow, 1).Value
Else
sRange = sRange & "," & Cells(iRow, 1).Value
End If
iRow = iRow + 1
Loop
.Range(Range("A1").Value).Copy .Range(sRange)
.UsedRange.Value = .UsedRange.Value
Application.CutCopyMode = False
End With
ChDrive Left(sMem, 1)
ChDir sMem
MsgBox "Daten importiert!"
End
Sub
Die zu kopierenden zellbereiche stehen in der Importdatei unter A1:A4
c1:c4
F1:F2
d1:d50
e1:e50
usw....
Habt ihr vielleicht einen optimierungsansatz.
Danke
Michael