Schritt 5
Übertagung der Informationen
Mit dieser Makro können jetzt die Informationen aus der Spalte H6 bis H15 aus dem Dashboard in die gewünschte Exceldatei (z.B. Artikelnummer588.xls) die in die 100 leeren Felder der Spalte B in 10ner Schritten untereinander hinweg eingelesen werden. Dadurch dass im Tabellenblatt DATA alle Informationen zu jeder Artikelnummer vorhanden ist, können per Formel die Informationen herausgefunden werden.
Sub DATENBANK1A()
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
'Schritt 5 Übertagung der Informationen
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Pfad anpassen
Pfad = "C:\Users\Artikel\"
inputname:
iZiel = InputBox("Öffne die Datei Artikelnummer um die Informationen zu übertragen", "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 "Artikelnummer" im geöffneten Workbook existiert
For i = 1 To wkb.Worksheets.Count
If wkb.Worksheets(i).Name = "ART-Beschreibung" Then shExists = True
Next i
'Falls nein, dann Meldung und Abbruch
If shExists = False Then
MsgBox "The Worksheet ART-Beschreibung doesn't exit in the Workbook named " & wkb.Name & "! Abort!", 16, "Error"
Exit Sub
End If
ThisWorkbook.Sheets("Dashboard").Range("H6:H15").copy 'kopieren
With wkb
.Worksheets("ART-Beschreibung").Range(Cells(IndexPos - 11 + 3, 15), Cells(IndexPos - 1 + 3, 15)).PasteSpecial Paste:=xlPasteValues 'Nur Werte einfügen
.Close (True) 'speichern und schließen
End With
'Kopierauswahl aufheben
Application.CutCopyMode = False
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
MsgBox "The data was copied", 64, "Copy finished"
End Sub
Vielen Dank Gruß Flo !
[*]
[sup]
*Threadedit* 02.10.2015, 14:04:43
Admininfo: Führe Threads bitte nicht fort, indem du weitere eröffnest, und vermeide Mehrfachanfragen! Siehe dazu unser FAQ 2, #3 - wie man einen Thread eröffnet[/sup]