Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1572to1576
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1572to1576
1572to1576
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Macro programierung

Macro programierung
02.08.2017 15:55:14
Peter,
Moin moin,
ich hoffe das mir jemand helfen kann.
Grundlage Zwei Arbeitsmappen mit je einem Tabellenblatt
Tabelle 1:
3085 Zeilen Spalten A bis F (jede Zelle mit Text oder Zahl gefüllt)
Tabelle 2:
Zieltabelle für Werte aus Tabelle 1
Schritte 1
aus Tabelle 1, Zelle A1 Kopieren nach Tabelle 2 in Zelle AA3 und B14
Schritte 2
aus Tabelle 1, Zelle B1 Kopieren nach Tabelle 2 in Zelle G14
Schritt 3
Speichern unter in Pfad: C:\Users\peter.urban\Desktop\Katwyk\Aufmass-(aus Zelle AA3).xls
Schritt 4 wie Schritt 1 Aus Tabelle 1 jedoch aus Zeile 2 selbe Spalten
Die Routinen 1 bis 3 müssen insgesamt 3085 Zeilen aus Tabelle 1 durchlaufen und Tabelle 2 entsprechend 3085 mal unter Speicher.
Ich hoffe ich habe mich verständlich ausgedrück und es gibt jemanden der mir helfen kann.
Mit freundlichem Gruß
Peter Urban

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nachfrage
02.08.2017 16:19:58
Michael
Hallo Peter!
Bisschen verwirrend Deine Anfrage. Kannst Du das nochmal präzisieren? Klar ist Du hast 2 Blätter in zwei Mappen (Quelle und Ziel), und die Quell-Daten reichen von A1:F3085.
Beschreibe doch bitte nochmal für die ersten drei Zeilen, also A1:F3, was genau passieren soll. Dann schauen wir weiter...
LG
Michael
AW: Nachfrage
02.08.2017 16:53:52
Peter,
Moin moin Michael,
Quelltabelle 1 Spalte A = Positionsnummern(xx.xx.xx.xxxx). Spalte B = LV Kurztext (z.B.Baustelle Räumen).
Tabelle 2 werden zu jeder Position Nummer einzene Aufmass-Blätter von Position 1 bis 3085
Um nicht 3085 positionsnummer und Kurztext händeisch zu kopieren und dann separat mit pos.nummer zu speichern meine Hoffnung dieses mit einem Mackro zu erschlagen.
in einer etwas erweterten Form habe ich es mal mit einer Aufzeichnung probiert. Jedoch muss ich an dieser Stelle den Block der einzelschritte nach unten Kopieren und Anpassen.
Sub Makro6()
' Makro6 Makro
Range("AA3").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R3C1"
Range("Q13:T13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R3C3"
Range("U13:V13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R3C5"
Range("Y13:Z13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R3C6"
Range("G14:W14").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R3C2"
Range("G15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\peter.urban\Desktop\Katwyk\Aufmass-1.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveSheet.Unprotect
Range("AA3").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R4C1"
Range("Q13:T13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R4C3"
Range("U13:V13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R4C5"
Range("Y13:Z13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R4C6"
Range("G14:W14").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R4C2"
Range("G15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\peter.urban\Desktop\Katwyk\Aufmass-2.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveSheet.Unprotect
Range("AA3").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R5C1"
Range("Q13:T13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R5C3"
Range("U13:V13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R5C5"
Range("Y13:Z13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R5C6"
Range("G14:W14").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R5C2"
Range("G15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\peter.urban\Desktop\Katwyk\Aufmass-3.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveSheet.Unprotect
Range("AA3").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R6C1"
Range("Q13:T13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R6C3"
Range("U13:V13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R6C5"
Range("Y13:Z13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R6C6"
Range("G14:W14").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R6C2"
Range("G15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\peter.urban\Desktop\Katwyk\Aufmass-4.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveSheet.Unprotect
Range("AA3").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R7C1"
Range("Q13:T13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R7C3"
Range("U13:V13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R7C5"
Range("Y13:Z13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R7C6"
Range("G14:W14").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R7C2"
Range("G15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\peter.urban\Desktop\Katwyk\Aufmass-5.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveSheet.Unprotect
Range("AA3").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R8C1"
Range("Q13:T13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R8C3"
Range("U13:V13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R8C5"
Range("Y13:Z13").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R8C6"
Range("G14:W14").Select
ActiveCell.FormulaR1C1 = "='[POS-NR-LV-Text.xls]Sheet1'!R8C2"
Range("G15").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\peter.urban\Desktop\Katwyk\Aufmass-6.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

Anzeige
Das analysiere ich jetzt nicht...
02.08.2017 17:10:02
Michael
Peter,
...sorry, aber das hilft mir nicht wirklich weiter zu verstehen, worum es Dir geht; und es motiviert mich auch nicht, wenn ich mich erst durch 2 Seiten Makro-Rekorder-Code wühlen muss.
Ich will lediglich von Dir eine einfache, klare, verständliche Beschreibung der Systematik Deines Kopier-Vorgangs. Zeige mir doch anhand von vielleicht 10 Beispiel-Datensätzen, was wohin kopiert werden soll - die beiden Tabellen können dafür ruhig in einer Beispiel-Mappe liegen, ich weiß, dass es in Deinem Original um verschiedene Mappen geht.
Lg
Michael
AW: Nachfrage
03.08.2017 09:00:52
Peter,
Moin moin habe die Quell und die Zieldatei hoch geladen.
POS-NR-LV-Text ist die Quelldatei, Blanko_Aufmass ist zieldatei
Gru0 Peter Urban
Anzeige
Link zur hochgeladenen Datei fehlt! owT
03.08.2017 09:58:05
Michael
OK, schau ich mir an, melde mich wieder, owT
03.08.2017 10:35:34
Michael
OK, teste mal...
03.08.2017 11:28:45
Michael
Peter,
...folgenden Code. Bedingungen/Hinweise:
- Quell- und Ziel-Datei sind parallel geöffnet
- Das Makro (der u.a. Code) liegt in einem allgemeinen Modul in der Ziel-Datei (startet von dort)
- Den Datei-Namen der Quell-Datei musst Du im Code korrekt ergänzen (inkl. Dateityp!, zB .xlsx)
- Die Blatt-Namen der Quell- und Ziel-Datei musst Du evtl. anpassen (aktuell "Tabelle1" und "Sheet1")
- Teste das evtl. mit nur den ersten 10 Einträgen in der Quell-Datei - falls noch was zu ändern ergänzen ist, hast Du sonst 3000 Dateien erstellt, die nichts bringen, und der Code läuft lange
- Zeilen in der Quelle, die eine OZ-Nummer mit nur 4 Stellen haben, werden ausgelassen (meine Annahme)
- Zeilen in der Quelle, die nichts im Kurztext stehen haben, werden ausgelassen (meine Annahme)
Sub a()
Const PFAD$ = "C:\Users\peter.urban\Desktop\Katwyk\" 'ggf. anpassen
'mit "\" schließen!
Const PRE$ = "Aufmass-" 'ggf. anpassen
Dim WbZ As Workbook: Set WbZ = ThisWorkbook 'Makro liegt in Ziel-Datei
Dim WbQ As Workbook: Set WbQ = Workbooks("Quelle.xlsx") 'anpassen
Dim WsZ As Worksheet: Set WsZ = WbZ.Worksheets("Tabelle1") 'ggf. anpassen
Dim WsQ As Worksheet: Set WsQ = WbQ.Worksheets("Sheet1") 'ggf. anpassen
Dim WbSave As Workbook, D&, AllOZ As Range, c As Range
Application.ScreenUpdating = False
With WsQ
Set AllOZ = .Range("A3:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
If MsgBox("Es werden ca. " & .Cells(.Rows.Count, 1).End(xlUp).Row & _
" Aufmaßblätter erstellt. Fortfahren?", vbOKCancel) = vbOK Then
For Each c In AllOZ
If Len(c) > 4 And Not IsEmpty(c.Offset(, 1)) Then
D = D + 1
WsZ.Range("B14") = c.Value
WsZ.Range("G14") = c.Offset(, 1).Value
WsZ.Range("Q13") = c.Offset(, 2).Value
WsZ.Range("U13") = c.Offset(, 4).Value
WsZ.Range("Y13") = c.Offset(, 5).Value
WsZ.Copy
Set WbSave = ActiveWorkbook
WbSave.SaveAs PFAD & PRE & D, FileFormat:=xlWorkbookDefault
WbSave.Close True
End If
Next c
MsgBox D & " Aufmaßblätter wurden unter [" & PFAD & "] erstellt.", _
vbInformation, "Fertig"
End If
End With
Set WbZ = Nothing: Set WbQ = Nothing: Set WsZ = Nothing
Set WsQ = Nothing: Set WbSave = Nothing: Set AllOZ = Nothing
Set c = Nothing
End Sub
Gib Bescheid!
LG
Michael
Anzeige
Na, Peter, wie sieht's aus? Klappt? owT
03.08.2017 15:17:33
Michael
AW: Nachfrage
04.08.2017 13:42:43
Peter,
Moin moin Michael,
schon mal ein Danke für Deine Hilfe, Ich hoffe ich habe das Programm in soweit richtig gelesen als das WbZ und WbQ jeweils Quell und Ziel bedeuten. Somit habe ich Zeile 4 angepasst auf den Namen der Quelldatei. jedoch ohne Erfolg beim Probelauf bleibt es an dieser stelle hängen.
'Dim WbQ As Workbook: Set WbQ = Workbooks("POS-NR-LV-Text.xlsx") 'anpassen'
Ja, richtig verstanden...
04.08.2017 13:52:41
Michael
Peter,
...WbZ ist die Objekt-Variable für die Ziel-Mappe, WbQ die Objekt-Variable für die Quell-Mappe.
Wenn Du den Mappen-Namen richtig angegeben hast beachte auch, dass diese Mappe auch bereits geöffnet sein muss! Durch meinen Code wird die Datei NICHT selbständig geöffnet (das würde anderen Code erfordern).
Kann sein, dass ich heute nicht mehr lange im Forum bin - falls noch was offen ist, ich bin ab Montag wieder hier.
LG
Michael
Anzeige
AW: Nachfrage
04.08.2017 13:57:06
Peter,
Moin moin Michael,
ein klein bissel probiert und die Quelldatei auf *.xlsm gespeichert und nun arbeitet das Programm wie ein Uhrwerk.
Ich Danke Dir recht herzlich
Gruß
Peter Urban
Freut mich! Gerne! Danke für die Rückmeldung, owT
04.08.2017 14:23:38
Michael

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige