Makroaufzeichnung effizienter gestalten
04.01.2020 14:02:31
Richi
Kann mir jemand helfen ein aufgezeichnetes Makro effizienter zu gestalten?
Erster Schritt: eine Mappe in ein neues File zu kopieren. Diesen Schritt mache ich um alle Formatierungen mitzunehmen (auch die bedingten).
Zweiter Schritt mittels Pastspecial nur den Wert (ohne Formeln) in die Felder eintragen. Warum ich in zwei Steps kopiere kommt daher, dass die Spalten beim Kopieren Probleme machten ansonsten hätte ich Range A1:NZ700 gewählt
Letzter Schritt (dieser wäre neu und ein Wunsch) Der Filename sollte final automatisch mit der Wochennummer/Jahr und einem Zähler wie oft mal es in der Woche erstellt wurde hinterlegt werden (z.B. PPS-Tool W1_2020_Save 1)
Ich danke jetzt schon den edlen Helfern.
Sub Makro1()
' Makro1 Makro
Sheets("Single Line View").Select
Sheets("Single Line View").Copy
Windows("PPS_V_14_1 - Standzeiten 2020 - Kopie.xlsm").Activate
Range("A1:A598").Select
ActiveWindow.ScrollRow = 572
ActiveWindow.ScrollRow = 569
ActiveWindow.ScrollRow = 567
ActiveWindow.ScrollRow = 563
ActiveWindow.ScrollRow = 559
ActiveWindow.ScrollRow = 554
ActiveWindow.ScrollRow = 548
ActiveWindow.ScrollRow = 543
ActiveWindow.ScrollRow = 537
ActiveWindow.ScrollRow = 532
ActiveWindow.ScrollRow = 526
ActiveWindow.ScrollRow = 520
ActiveWindow.ScrollRow = 516
ActiveWindow.ScrollRow = 510
ActiveWindow.ScrollRow = 506
ActiveWindow.ScrollRow = 502
ActiveWindow.ScrollRow = 497
ActiveWindow.ScrollRow = 492
ActiveWindow.ScrollRow = 487
ActiveWindow.ScrollRow = 482
ActiveWindow.ScrollRow = 477
ActiveWindow.ScrollRow = 470
ActiveWindow.ScrollRow = 465
ActiveWindow.ScrollRow = 457
ActiveWindow.ScrollRow = 415
ActiveWindow.ScrollRow = 409
ActiveWindow.ScrollRow = 403
ActiveWindow.ScrollRow = 397
ActiveWindow.ScrollRow = 390
ActiveWindow.ScrollRow = 383
ActiveWindow.ScrollRow = 376
ActiveWindow.ScrollRow = 370
ActiveWindow.ScrollRow = 362
ActiveWindow.ScrollRow = 355
ActiveWindow.ScrollRow = 347
ActiveWindow.ScrollRow = 339
ActiveWindow.ScrollRow = 332
ActiveWindow.ScrollRow = 323
ActiveWindow.ScrollRow = 314
ActiveWindow.ScrollRow = 307
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 283
ActiveWindow.ScrollRow = 276
ActiveWindow.ScrollRow = 268
ActiveWindow.ScrollRow = 262
ActiveWindow.ScrollRow = 256
ActiveWindow.ScrollRow = 250
ActiveWindow.ScrollRow = 245
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 176
ActiveWindow.ScrollRow = 169
ActiveWindow.ScrollRow = 162
ActiveWindow.ScrollRow = 155
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 140
ActiveWindow.ScrollRow = 123
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
Range("A3:A606").Select
Selection.Copy
Windows("Mappe1").Activate
Windows("PPS_V_14_1 - Standzeiten 2020 - Kopie.xlsm").Activate
ActiveWindow.ScrollRow = 587
ActiveWindow.ScrollRow = 585
ActiveWindow.ScrollRow = 582
ActiveWindow.ScrollRow = 581
ActiveWindow.ScrollRow = 578
ActiveWindow.ScrollRow = 577
ActiveWindow.ScrollRow = 576
ActiveWindow.ScrollRow = 575
ActiveWindow.ScrollRow = 573
ActiveWindow.ScrollRow = 571
ActiveWindow.ScrollRow = 570
ActiveWindow.ScrollRow = 568
ActiveWindow.ScrollRow = 567
ActiveWindow.ScrollRow = 565
ActiveWindow.ScrollRow = 563
ActiveWindow.ScrollRow = 562
ActiveWindow.ScrollRow = 560
ActiveWindow.ScrollRow = 559
ActiveWindow.ScrollRow = 557
ActiveWindow.ScrollRow = 554
ActiveWindow.ScrollRow = 551
ActiveWindow.ScrollRow = 547
ActiveWindow.ScrollRow = 542
ActiveWindow.ScrollRow = 539
ActiveWindow.ScrollRow = 533
ActiveWindow.ScrollRow = 525
ActiveWindow.ScrollRow = 521
ActiveWindow.ScrollRow = 517
ActiveWindow.ScrollRow = 511
ActiveWindow.ScrollRow = 506
ActiveWindow.ScrollRow = 499
ActiveWindow.ScrollRow = 493
ActiveWindow.ScrollRow = 486
ActiveWindow.ScrollRow = 477
ActiveWindow.ScrollRow = 460
ActiveWindow.ScrollRow = 410
ActiveWindow.ScrollRow = 399
ActiveWindow.ScrollRow = 387
ActiveWindow.ScrollRow = 374
ActiveWindow.ScrollRow = 359
ActiveWindow.ScrollRow = 345
ActiveWindow.ScrollRow = 330
ActiveWindow.ScrollRow = 314
ActiveWindow.ScrollRow = 275
ActiveWindow.ScrollRow = 255
ActiveWindow.ScrollRow = 227
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
Windows("Mappe1").Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("PPS_V_14_1 - Standzeiten 2020 - Kopie.xlsm").Activate
Range("B6:NB606").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Mappe1").Activate
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"\\chbs2741.rintra.ruag.com\ee5172$\Documents\PPS-Tool Standzeiten W1.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("PPS_V_14_1 - Standzeiten 2020 - Kopie.xlsm").Activate
End Sub