Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1508to1512
1508to1512
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Vorlage übertragen

Forumthread: Vorlage übertragen

Vorlage übertragen
10.08.2016 14:48:01
Michael
Hallo Excelexperten
Bräuchte mal eure Hilfe habe schon einen Beitrag zu diesem Thema geschrieben aber der ist etwasblöd beschrieben weiß aber nicht wie man den löschen kann.
Habe eine Vorlage in der ich mir Daten über eine Dropdown liste hole.
Diese soll dann mit einem Button übertragen werden in eine andere Mappe die auf dem Laufwerk liegt und nach Ordnern sortiert ist in den Ordnern befinden sich dann die Zeichnungsnummern.
Also müsste das Makro nach dem Ordner mit der Lacknummer aus der Zelle"D11"z.b.(00707-702) suchen.
Die Ordner liegen auf
"K:\DatenAustausch\Lackieraufträge-Muster\Venjakob PC Programm\Protokoll"
Und dann nach der Zeichnungsnummer Zelle"C5"z.b.(13061-359).Da mehrere Zeichnungsnummern in einem Ordner seien können.
Die Ziel Mappe hat einen Blattschutz "preh"und ist genauso aufgebaut wie die Vorlage nur mit Matrix.
Aus der Vorlage müssten dann alle grau hinterlegten Felder kopiert werden und in die Ziehldatei an selber stelle wieder eingefügt werden ohne das in der Ziehldatei die Formatierungen gelöscht werden(wichtig).
so ich hoffe die Erklärung ist einigermaßen verständlich und ihr könnt mir helfen.
Ist für die Arbeit.
Grüße und einen schönen Tag euch allen
Michael
https://www.herber.de/bbs/user/107535.xlsm
Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Vorlage übertragen
11.08.2016 03:13:42
fcs
Hallo Michael,
ein entsprechendes Makro kann wie folgt aussehen.
Gruß
Franz 
Sub Übertrag()
' Übertrag Makro
Dim sVwez As String, sUVerz As String, sDatei As String
Dim wkbM As Workbook
Dim wksQ As Worksheet, wksM As Worksheet
Dim Zeile As Long, Spalte As Long
Set wksQ = ActiveSheet
sverz = "K:\DatenAustausch\Lackierauftraege-Muster\Venjakob PC Programm\Protokoll\"
sverz = "C:\Users\Public\Test\Archiv\"
sUVerz = wksQ.Cells(11, 4).Text & "\"
sDatei = Dir(sverz & sUVerz & wksQ.Cells(5, 3).Text & ".xls*")
If sDatei  "" Then
Set wkbM = Application.Workbooks.Open(Filename:=sverz & sUVerz & sDatei)
Set wksM = wkbM.Worksheets(1) 'oder Worksheets("Blattname") wenn in allen Dateien  _
identisch
wksM.Unprotect "preh"
With wksM
Zeile = 3
Spalte = 1 'Spalte A
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftrags-Nr.
Zeile = 8
Spalte = 3 'Spalte C
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftrags-Nr.
Spalte = 7 'Spalte G
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftragsmenge.
'Hilfstoffe
Spalte = 2 'Spalte B
For Zeile = 11 To 14
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
Spalte = 4 'Spalte D
For Zeile = 11 To 14
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
.Cells(11, 6).Value = wksQ.Cells(11, 6).Value 'Charge
'Daten/Parameter
Spalte = 3 'Spalte C
For Zeile = 16 To 31
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
'IR-Modul
Spalte = 8 'Spalte H
For Zeile = 24 To 29
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
'UV-Modul
Spalte = 8 'Spalte H
For Zeile = 31 To 34
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
'Drehwinkel der Pistolen
Spalte = 2 'Spalte B
For Zeile = 33 To 36
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
Spalte = 4 'Spalte D
For Zeile = 33 To 36
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
'Co² Reinigung
Spalte = 3 'Spalte C
For Zeile = 38 To 40
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
'PowerPuck
For Zeile = 37 To 40
For Spalte = 7 To 8 'Spalten G:H
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
Next
'Farbangaben
For Zeile = 43 To 49
For Spalte = 3 To 3 'Spalte C
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value
Next
Next
'Besondere Hinweise
Zeile = 51
Spalte = 1 'Spalte A
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftrags-Nr.
Zeile = 52
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftrags-Nr.
'Datum
Zeile = 53
Spalte = 2 'Spalte B
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftrags-Nr.
'Unterschrift
Spalte = 6 'Spalte F
.Cells(Zeile, Spalte).Value = wksQ.Cells(Zeile, Spalte).Value 'Auftrags-Nr.
.Protect "preh"
'            wkbM.Close savechanges:=True
End With
Else
MsgBox "Datei " & vbLf & "...\" & sUVerz & wksQ.Range("C5").Text & ".xls*" & vbLf _
& "nicht gefunden!."
End If
End Sub

Anzeige
AW: Vorlage übertragen
11.08.2016 06:37:12
Michael
Hallo Franz
vielen dank werde es heut Abend gleich mal ausprobieren und mich dann wieder melden.
Gruß Michael
AW: Vorlage übertragen
11.08.2016 22:15:36
Michael
Hallo Franz
habe gerade dein Makro ausprobiert und er zeigt mir immer an keine Datei gefunden.
Gruß Michael
AW: Vorlage übertragen
12.08.2016 00:53:59
fcs
Hallo Michael,
lösche die Zeile 
    sverz = "C:\Users\Public\Test\Archiv\"

Diese Zeile hatte ich vergessen nach dem Testen zu löschen.
Gruß
Franz
Anzeige
AW: Vorlage übertragen
12.08.2016 01:01:57
Michael
Hallo Franz
habe ich gemacht funktioniert immer noch nicht.
Habe auch mal von xls auf xlsm probiert findet er auch nicht.
Gruß Michael
AW: Vorlage übertragen
12.08.2016 01:26:53
Michael
Hallo Hans
Hab den Fehler gefunden in dem Ziehl Ordner stehen die Namen nicht 13034-556 sondern 13034-556 Wippe zentral .xlsm
Was muss ich dann im Code ändern damit er es findet.
Gruß Michael
Anzeige
AW: Vorlage übertragen
13.08.2016 10:46:27
fcs
Hallo Michael,
in der folgenden Zeile wird die Suche nach dem zu suchenden Dateinamen definiert: 
         sDatei = Dir(sverz & sUVerz & wksQ.Cells(5, 3).Text & ".xls*")

Wenn der Eintrag in Zelle C5 immer eindeutig für den Anfang des Dateinamens ist, dann kannst du mit folgender Anpassung arbeiten. 
         sDatei = Dir(sverz & sUVerz & wksQ.Cells(5, 3).Text & "*")
'oder wenn es immer Dateien mit der Endung ".xlsm" sind
sDatei = Dir(sverz & sUVerz & wksQ.Cells(5, 3).Text & "*.xlsm")

Wenn alle Dateinamen in den Unterordnern auf " Wippe zentral .xlsm" enden, dann geht es auch so: 
         sDatei = Dir(sverz & sUVerz & wksQ.Cells(5, 3).Text & " Wippe zentral .xlsm")
Gruß
Franz
Anzeige
AW: Vorlage übertragen
13.08.2016 10:53:44
Michael
Hallo Franz
Danke jetzt funktioniert es super.
Viele Dank
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige