AW: Problem bei Upload
22.03.2010 16:19:06
fcs
Hallo Roland,
hier noch eine Variante mit Datei-Öffnen-Dialag für Quelle und Auswahl der Spalten durch Eingabe in Inputbox.
Gruß
Franz
Sub DatenHolen()
Dim wbZiel As Workbook, wksZiel As Worksheet, vAuswahl
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim sArtikel$, sBenennung$, sBestand$, LetzteZeileQ As Long, LetzteZeileZ As Long
'Quelldatei auswählen
vAuswahl = Application.GetOpenFilename(Filefilter:="Excel (*.xl*),*.xl*", _
Title:="Bitte Datenquelle öffnen")
If vAuswahl = False Then Exit Sub
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets("Tabelle1")
'Quelldatei öffnen
Set wbQuelle = Application.Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets(1)
'Spalten abfragen
vAuswahl = InputBox("In welcher Spalte steht die Artikelnummer - Bitte Buchstabe(n) eingeben?" _
, _
"Datenimport - Spalte Artikel-Nr.")
If vAuswahl = "" Then Exit Sub
sArtikel = vAuswahl
vAuswahl = InputBox("In welcher Spalte steht die Benennung - Bitte Buchstabe(n) eingeben?" _
& vbLf & vbLf & "Artikelnummer - Spalte: " & sArtikel, "Datenimport - Spalte Benennung.")
If vAuswahl = "" Then Exit Sub
sBenennung = vAuswahl
vAuswahl = InputBox("In welcher Spalte steht der Lagerbestand - Bitte Buchstabe(n) eingeben?" _
_
& vbLf & vbLf & "Artikelnummer - Spalte: " & sArtikel & vbLf _
& "Benennung - Spalte : " & sBenennung, "Datenimport - Spalte Lagerbestand.")
If vAuswahl = "" Then Exit Sub
sBestand = vAuswahl
With wksQuelle
'Letzte Zeile i Quelltabelle
LetzteZeileQ = .Cells.SpecialCells(xlCellTypeLastCell).Row
'Letzte Datenzeile in Zieltabelle
With wksZiel
LetzteZeileZ = .Cells(.Rows.Count, 1).End(xlUp).Row
If LetzteZeileZ = 1 And IsEmpty(.Range("A1")) Then LetzteZeileZ = 0
End With
'Datenkopieren
.Range(sArtikel & 1 & ":" & sArtikel & LetzteZeileQ).Copy _
Destination:=wksZiel.Cells(LetzteZeileZ + 1, 1)
.Range(sBenennung & 1 & ":" & sBenennung & LetzteZeileQ).Copy _
Destination:=wksZiel.Cells(LetzteZeileZ + 1, 2)
.Range(sBestand & 1 & ":" & sBestand & LetzteZeileQ).Copy _
Destination:=wksZiel.Cells(LetzteZeileZ + 1, 3)
End With
'Quelldatei wieder schliessen
wbQuelle.Close savechanges:=False
'Zieldatei anzeigen
wbZiel.Activate
wksZiel.Activate
Cells(LetzteZeileZ + 1, 1).Select
End Sub
