VBA Datei 2. Mal geöffnet

Hallo,
mit einem Code in der Ziel-Datei, über einen Button, hole ich mir Daten (Spalten) aus der Preisliste. Klappt auch. Nur wenn die Preisliste schon geöffnet ist, erhalte ich eine Fehlermeldung ( kann kein 2. Mal geöffnet werden)
Ich möchte gerne, dass stattdessen eine MSG-Box erscheint: Bitte schließen Sie die Preisliste und starten das Einlesen erneut - o.s.ä. und dann ein Wechsel zur Preisliste, damit der Anwender diese schließen kann.
Da die Preisliste (Dateiname) eine Variable ist, habe ich keine Ahnung, wie ich das Problem lösen kann.
Gleichzeitig möchte ich auch, das beim Einlesen die Artikelnummer als Standard eingelesen wird, da ich diese später über SVERWEIS weiterverarbeiten muss, zurzeit wird der Wert so eingelesen: 001301 und wird dann nicht erkannt.
Freue mich über jede Hilfe. Danke schon einmal im Voraus.
Preisliste: https://www.herber.de/bbs/user/148351.xlsx
Zieldatei: https://www.herber.de/bbs/user/148352.xlsm
Gruß Claudia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim objWb As Workbook ' If varFile = False Then Exit Sub For Each objWb In Application.Workbooks If objWb.FullName = varFile Then objWb.Close SaveChanges:=False Exit For End If Next Set wbQuelle = Workbooks.Open(varFile)

Private Sub CommandButton1_Click() Dim varFile As Variant, wbQuelle As Workbook Dim vntTMP Dim lastRow As Long Application.ScreenUpdating = False Application.DisplayAlerts = False varFile = Application.GetOpenFilename() If varFile "Falsch" Then On Error Resume Next vntTMP = Split(varFile, "\") Set wbQuelle = Workbooks(vntTMP(UBound(vntTMP))) On Error GoTo 0 If wbQuelle Is Nothing Then Set wbQuelle = Workbooks.Open(varFile) End If With wbQuelle.Sheets("Sheet1") lastRow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("B10:C" & lastRow & ", E10:E" & lastRow & ", O10:O" & lastRow).SpecialCells(xlCellTypeVisible).copy End With ThisWorkbook.Sheets("preisliste").Range("A1").PasteSpecial _ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False wbQuelle.Close SaveChanges:=False End If 'Variablen aufräumen Set wbQuelle = Nothing 'Kopierspeicher leeren Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

MCOs Code leicht modifiziert:


Sub Datenimport()
Dim varFile As Variant, wbQuelle As Workbook
varFile = Application.GetOpenFilename()
Dim objWb As Workbook
Dim lastRow As Long
Dim wbQsh As Worksheet
Dim copyrange As Range
Dim wbZielSh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If varFile = False Then MsgBox "Abbruch", vbInformation: Exit Sub
For Each objWb In Application.Workbooks
If objWb.FullName = varFile Then
Set wbQuelle = objWb
Exit For
End If
Next
If wbQuelle Is Nothing Then Set wbQuelle = Workbooks.Open(varFile)
Set wbQsh = wbQuelle.Sheets("Sheet1")
Set wbZielSh = ThisWorkbook.Sheets("preisliste")
lastRow = wbQsh.Cells(Rows.Count, "A").End(xlUp).Row
Set copyrange = wbQsh.Range("B10:C" & lastRow & ", E10:E" & lastRow & ", O10:O" & lastRow)
With wbZielSh
.Columns("A:E").ClearContents
copyrange.SpecialCells(xlCellTypeVisible).Copy
wbZielSh.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Daten als Wert setzen
.Columns(1).TextToColumns Destination:=wbZielSh.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
wbQuelle.Close SaveChanges:=False
.Range("A1").Select
End With
'Application.CutCopyMode = False 'Kopierspeicher leeren, überflüssig da Mappe geschlossen
'Variablen aufräumen
Set wbQuelle = Nothing
Set wbQsh = Nothing
Set wbZielSh = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

41 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Datei 2. Mal geöffnet

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

41 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread