|
Hallo
ich habe hierbei folgendes Problem.Genau hier wollte ich gerne, dass wenn ich mehr als 100 Artikel beschreibungen habe die zu kopieren sind, das sich die Makro nicht schließt sonder offen bleibt und ich weitere 10 hinein kopieren kann ohne erneut die Makro wieder aufrufen zu müssen und erneut den Dateinamen in die MsgBox eingeben zu müssen.
Da ich sonst bei beispielsweise bei 500 Artikelbeschreibung 50 mal die Datei eintippen muss. Am Ende könnte mann ja fragen weiter? wenn nicht dann die Datei schließen.
Sub DATENBANK()
Dim anw
Dim Pfad As String
Dim Datei As String
Dim i As Long
Dim shExists As Boolean
Dim lz As Long
Dim Ziel As String
Dim iZiel As String
Dim wbk As Workbook
'STEP 5 Transfer the Data into an ANNEX
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Pfad anpassen
Pfad = "C:\Users\.........'
inputname:
iZiel = InputBox("Open up the Data to transfer the Justifications", "Input Filename", iZiel)
If iZiel = "" Then
anw = MsgBox("Invalid name! Try again?", 20, "Error")
If anw = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If
'Endung ggf. anpassen
Ziel = iZiel & ".xls"
Datei = Pfad & Ziel
If Dir(Datei) = "" Then
anw = MsgBox("The file " & Ziel & " doesn't exist! Try again?", 20, "Error")
If anw = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If
'Zieldatei öffnen
Workbooks.Open Filename:=Datei
Set wkb = Workbooks.Open(Filename:=Datei)
'Prüfen ob Tabelle mit Namen "Artikelnr" im geöffneten Workbook existiert
For i = 1 To wkb.Worksheets.Count
If wkb.Worksheets(i).Name = "Tasks" Then shExists = True
Next i
'Falls nein, dann Meldung und Abbruch
If shExists = False Then
MsgBox "The Worksheet Tasks doesn't exit in the Workbook named " & wkb.Name & "! Abort!", 16, "Error"
Exit Sub
End If
ThisWorkbook.Sheets("Dashboard").Range("H6:H15").copy With wkb
.Worksheets("Tasks").Range(Cells(IndexPos - 11 + 3, 15), Cells(IndexPos - 1 + 3, 15)).PasteSpecial Paste:=xlPasteValues
.Close (True) End With
Application.CutCopyMode = False 'Kopierauswahl aufheben
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
MsgBox "The data was copied", 64, "Copy finished"
End Sub
|