Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
844to848
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
844to848
844to848
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Einfügen v. Formel für alle Worksheets jeden Tag

Einfügen v. Formel für alle Worksheets jeden Tag
20.02.2007 11:47:45
Thomas
Hallo,
ich habe ein kleines Problem mit meinem Makro in Excel.
Ich habe ein Workbook mit verschieden Tagen, jeden Tag muss ich aus dem Internet Daten runterladen und in ein neues Sheet pasten. Danach dann auf dem Sheet immer die gleichen Formeln anwenden.
So weit so gut, für ein Sheet funktioniert es auch, aber für den nächsten Tag dann nicht mehr, weil die Formel die eingefügt werden immer wieder aufs erste Sheet zurückgehen.
Meine frage nun, wie kann ich das machen, das der Makro jeden Tag aufs neue für ein neues Sheet funktioniert?
Hier der Macro:

Sub Macro1()
Range("I1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("I1").Select
Selection.Copy
Range("I3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range("I1").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 93
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 97
ActiveWindow.ScrollRow = 99
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 101
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 105
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 107
ActiveWindow.ScrollRow = 109
ActiveWindow.ScrollRow = 111
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 113
ActiveWindow.ScrollRow = 114
ActiveWindow.ScrollRow = 115
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 117
ActiveWindow.ScrollRow = 118
ActiveWindow.ScrollRow = 119
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 121
ActiveWindow.ScrollRow = 122
ActiveWindow.ScrollRow = 123
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 126
ActiveWindow.ScrollRow = 127
ActiveWindow.ScrollRow = 128
ActiveWindow.ScrollRow = 129
ActiveWindow.ScrollRow = 131
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 135
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 138
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 140
ActiveWindow.ScrollRow = 142
ActiveWindow.ScrollRow = 144
ActiveWindow.ScrollRow = 145
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 150
ActiveWindow.ScrollRow = 151
ActiveWindow.ScrollRow = 152
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 155
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 157
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 159
ActiveWindow.ScrollRow = 160
ActiveWindow.ScrollRow = 164
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 171
ActiveWindow.ScrollRow = 174
ActiveWindow.ScrollRow = 176
ActiveWindow.ScrollRow = 179
ActiveWindow.ScrollRow = 182
ActiveWindow.ScrollRow = 183
ActiveWindow.ScrollRow = 185
ActiveWindow.ScrollRow = 186
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 188
ActiveWindow.ScrollRow = 191
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 195
ActiveWindow.ScrollRow = 197
ActiveWindow.ScrollRow = 198
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 200
ActiveWindow.ScrollRow = 202
ActiveWindow.ScrollRow = 204
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 206
ActiveWindow.ScrollRow = 207
ActiveWindow.ScrollRow = 208
ActiveWindow.ScrollRow = 209
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 211
ActiveWindow.ScrollRow = 212
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 214
ActiveWindow.ScrollRow = 216
ActiveWindow.ScrollRow = 218
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 221
ActiveWindow.ScrollRow = 222
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 224
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 227
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 229
ActiveWindow.ScrollRow = 230
ActiveWindow.ScrollRow = 231
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 234
ActiveWindow.ScrollRow = 235
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 238
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 240
ActiveWindow.ScrollRow = 242
ActiveWindow.ScrollRow = 243
ActiveWindow.ScrollRow = 244
ActiveWindow.ScrollRow = 245
ActiveWindow.ScrollRow = 247
ActiveWindow.ScrollRow = 248
ActiveWindow.ScrollRow = 250
ActiveWindow.ScrollRow = 251
ActiveWindow.ScrollRow = 253
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 255
ActiveWindow.ScrollRow = 256
ActiveWindow.ScrollRow = 257
ActiveWindow.ScrollRow = 258
ActiveWindow.ScrollRow = 259
ActiveWindow.ScrollRow = 261
ActiveWindow.ScrollRow = 262
ActiveWindow.ScrollRow = 263
ActiveWindow.ScrollRow = 264
ActiveWindow.ScrollRow = 265
ActiveWindow.ScrollRow = 264
ActiveWindow.ScrollRow = 263
ActiveWindow.ScrollRow = 262
ActiveWindow.ScrollRow = 261
ActiveWindow.WindowState = xlMaximized
Sheets("Dealer").Select
Selection.Copy
Sheets("17.02.07").Select
Range("I268").Select
ActiveSheet.Paste
Sheets("Formulas").Select
Range("F399:AD414").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("17.02.07").Select
ActiveWindow.SmallScroll Down:=120
Range("F399").Select
ActiveSheet.Paste
Columns("J:AE").Select
Range("J381").Activate
Columns("J:AE").EntireColumn.AutoFit
End Sub

Ich danke denen schon mal. die sich mit meinem Problem befassen!

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Einfügen v. Formel für alle Worksheets jeden Tag
20.02.2007 12:06:00
IngGi
Hallo Thomas,
auf's wesentliche verkürzt müsste das hier funktionieren:

Sub Macro1()
    Range("I1") = "1"
    Range("I1").Copy
    Range("I3", Range("I3").End(xlDown)).PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
    Range("I1").ClearContents
    Sheets("Dealer").Select
    Selection.Copy Destination:=Sheets(Format(Date, "dd.mm.yy")).Range("I268")
    Sheets("Formulas").Range("F399:AD414").Copy _
        Destination:=Sheets(Format(Date, "dd.mm.yy")).Range("F399")
    Sheets(Format(Date, "dd.mm.yy")).Columns("J:AE").EntireColumn.AutoFit
End Sub

Gruß Ingolf
Anzeige
Danke, aber...
20.02.2007 12:44:00
Thomas
Vielen dank für die Lösung,
ich erkläre jetzt noch mal genauer,...
Ich lade eine Datei mit vielen Daten aus dem Internet runter, kopiere diese dann in den richtigen Wochentag (Mo-Sa). Da eine Spalte noch formatiert werden muss, damit mein VLOOKUp funktioniert, muss ich diese mit 1 malnehmen. Das ist der ActiveWindow.ScrollRow.
Danach muss ich nacheinander zwei Formeln einfügen , die sich in zwei weiten Worksheets befinden (Dealer; Formulas) und zwar genau in das Feld (Dealer: I268; Formulas: F 399), damit die Formeln funktionieren...
Wenn ich das (wie im Beispielmacro) für einen Tag gemacht habe ist es gut, wenn ich dann am nächsten Tag das machsen will, springt das Macro direkt nachdem die Spalte formatiert ist wieder in das alte Blatt zurück. Das will ich natürlich nicht.
So ich hoffe du hilfst mir noch mal...
lieben Gruß
Anzeige
AW: Danke, aber...
20.02.2007 13:25:00
IngGi
Hallo Thomas,
genau das sollte das von mir modifizierte Makro eigentlich machen. Was genau macht es denn nicht, bzw. macht es, obwohl es nicht soll?
Gruß Ingolf
AW: Danke, aber...
20.02.2007 14:19:59
Thomas
Hallo Ingolf,
schön das du dich meinem Problem widmest, nun, wenn ich deinen Macro starte, dann führt er auch die erste Sache aus und formatiert die richtige Spalte, aber danach springt er direkt zu dem Sheet "Dealer" und macht danach gar nix mehr...
d.h. der Teil mit dem Formel die in Dealer und Formulas sind funktioniert nicht...
Gruß
Thomas
AW: Danke, aber...
20.02.2007 14:40:00
IngGi
Hallo Thomas,
hast du mal in das Sheet "20.02.07" reingeschaut? Dort sollte er eigentlich die Formeln einfügen. Das er das Blatt nicht aktiviert heißt nicht, dass er darin nichts tut. Man muss ein Blatt nicht aktivieren, um dort etwas zu tun. Eigentlich macht das Makros nur langsam, darum hab ich's weggelassen. Das Blatt für heute (20.02.07) existiert doch?
Gruß Ingolf
Anzeige
AW: Danke, aber...
20.02.2007 14:48:00
Thomas
Hallo Ingolf,
Das Blatt existiert, hab Blätter für den ganzen Monat, aber auch in diesem ist nix.
Der hört nach der Formatierung auf.
Gruß
Thomas
AW: Danke, aber...
20.02.2007 16:24:00
IngGi
Hallo Thomas,
ich habe das jetzt mal nachgebaut und getestet. Funktioniert bei mir einwandfrei. Wo jetzt das Problem liegt, läßt sich per Ferndiagnose wohl nicht sagen. Bleibt wohl nur noch, dass du die Mappe hochlädst.
Gruß Ingolf
AW: Danke, aber...
20.02.2007 16:29:00
Thomas
Hallo,
mhh, so ein Ärger... die Mappe hochladen aber wie und wo?
Gruß Thomas
ok, mappe hochgeladen
20.02.2007 16:50:00
Thomas
Hallo,
hab die Mappe jetzt hochgeladen, hab alles unwichtige gelöscht. Weil es sonst zu groß war
Du findest die 2 Sheets mit Formeln und ein Sheet mit Datum von heute...
https://www.herber.de/bbs/user/40572.zip
Freu mich wenn du mir weiterhin hilfst...
Gruß
Thomas
Anzeige
AW: ok, mappe hochgeladen
20.02.2007 17:23:12
IngGi
Hallo Thomas,
gleich eine Rückfrage. Nachdem das Makro auf das Tabellenblatt "Dealer" gewechselt hat, wird die aktuelle Auswahl/Markierung von dort in das Tabellenblatt "20.02.07" in die Zelle I268 kopiert. Welcher Bereich auf dem Tabellenblatt "Dealer" muß da markiert sein bzw. soll kopiert werden? Eine falsche Markierung könnte hier eine Fehlerquelle sein.
Gruß Ingolf
AW: ok, mappe hochgeladen
20.02.2007 22:22:00
Thomas
Hallo,
Ich hoffe du hilfst mir noch weiter...
auf dem Blatt "Dealer" muss der Bereich I:AD in der Breite und 268:396 in der Länge kopiert werden und genauso auch auf das Blatt mit dem Datum gepastet werden.
Das Blatt "Formulas" muss F:AD in der Breite und 399:414 in der Länge kopiert und auch genauso unter die Frmeln von Dealer gepastet werden.
Ich danke dir schon mal
Gruß
Thomas
Anzeige
AW: ok, mappe hochgeladen
20.02.2007 22:43:00
IngGi
Hallo Thomas,
da lag wohl tatsächlich der Hund in der falschen Markierung auf "Dealer" begraben. Bei mir hat das jetzt mit folgendem, nochmal modifiziertem Code funktioniert und ich bin optimistisch, dass es so auch bei dir geht.

Sub Macro1()
   Range("I1") = "1"
   Range("I1").Copy
   Range("I3", Range("I3").End(xlDown)).PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlMultiply, SkipBlanks:=False, Transpose:=False
   Range("I1").ClearContents
   Sheets("Dealer").Range("I268:AD396").Copy _
      Destination:=Sheets(Format(Date, "dd.mm.yy")).Range("I268:AD396")
   Sheets("Formulas").Range("F399:AD414").Copy _
      Destination:=Sheets(Format(Date, "dd.mm.yy")).Range("F399:AD414")
   Sheets(Format(Date, "dd.mm.yy")).Columns("J:AE").EntireColumn.AutoFit
End Sub

Gruss Ingolf
Anzeige
neues Problem
21.02.2007 08:50:00
Thomas
Hallo Ingolf,
ja, jetzt klappt es auch bei mir.... vielen Dank, aber es tritt ein neuse Problem ein, denn jetzt pastet mir das ja immer auf den heutigen bzw Tag an dem ich das mache. Aber ich muss immer die Werte vom Vortag ermitteln und montags von freitag und samstag, dann funktioniert das nicht.
Ich weiß nicht ob man da was machen kann, oder ob ich die Sheets anders bennen soll, oder ob man was über den Index der Sheets machen kann?
Gruß
Thomas
AW: neues Problem
21.02.2007 22:54:00
IngGi
Hallo Thomas,
das läßt sich problemlos in das Makro integrieren.

Sub Macro1()
Dim Blatt As String
If Weekday(Date, vbMonday) > 1 Then
   Blatt = Format(Date - 1, "dd.mm.yy")
Else
   Blatt = Format(Date - 2, "dd.mm.yy")
End If
With Sheets(Blatt)
   .Range("I1") = "1"
   .Range("I1").Copy
   .Range("I3", Range("I3").End(xlDown)).PasteSpecial _
      Paste:=xlPasteAll, Operation:=xlMultiply
   .Range("I1").ClearContents
   Sheets("Dealer").Range("I268:AD396").Copy _
      Destination:=.Range("I268:AD396")
   Sheets("Formulas").Range("F399:AD414").Copy _
      Destination:=.Range("F399:AD414")
   .Columns("J:AE").EntireColumn.AutoFit
End With
If Weekday(Date, vbMonday) = 1 Then
   Blatt = Format(Date - 3, "dd.mm.yy")
   With Sheets(Blatt)
      .Range("I1") = "1"
      .Range("I1").Copy
      .Range("I3", Range("I3").End(xlDown)).PasteSpecial _
         Paste:=xlPasteAll, Operation:=xlMultiply
      .Range("I1").ClearContents
      Sheets("Dealer").Range("I268:AD396").Copy _
         Destination:=.Range("I268:AD396")
      Sheets("Formulas").Range("F399:AD414").Copy _
         Destination:=.Range("F399:AD414")
      .Columns("J:AE").EntireColumn.AutoFit
   End With
End If
End Sub

Gruß Ingolf
Anzeige

96 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige