Hier ein Code, der wechselseitig die gleichen Zellen färbt:

Sub srtDoubleMark()
Dim I As Long
Dim J As Long
Dim dblColorFlipFlop As Long

dblColorFlipFlop = 2 'vorbelegen des FlipFlops
' von Zelle A1 bis Zelle A (bis genutztes Maximum)
For I = 1 To ActiveSheet.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
    'wenn Zell emit nachfolgender Zelle gleich, dann
    If Cells(I, 1) = Cells(I + 1, 1) Then
        'Länge des Bereiches vorfestlegen
        J = 2
        ' FlipFlop schalten
        dblColorFlipFlop = 3 - dblColorFlipFlop
        ' Solange wie die nachfolgende Zelle immer noch gleich ist
        Do While Cells(I + J) = Cells(I, 1)
            'Den Bereich der Gleichen erweitern
            J = J + 1
        Loop
         ' Nun färben, je nach Stand des FlipFlop
         With ActiveSheet
            If dblColorFlipFlop = 1 Then
                .Range(Cells(I, 1), Cells(I + J - 1, 1)).Interior.Color = RGB(171, 171, 171)
            Else
                .Range(Cells(I, 1), Cells(I + J - 1, 1)).Interior.Color = RGB(140, 140, 140)
            End If
        End With
    End If
Next I
End Sub

Achtung, bis Excel 2003 kann man bei RGB nur bestimmte Werte benutzen. Erst ab Excel 2010 ist alles möglich.

Statt 
 Interior.Color = RGB( …) kann man auch sagen 
 Interior.Colorindex  = 16

Ganzzahlig, von 1 bis 57  möglich.

Zum Ermitteln der möglichen Farben noch zwei Codes:

Sub srtFarbTest1()
Dim I As Integer
For I = 255 To 5 Step -1
    Cells(256 - I, 1) = I
    Cells(256 - I, 2).Interior.Color = RGB(I, I, I)
Next I
End Sub

Und Code drei

Sub srtFarbTest2()
Dim I As Integer
For I = 1 To 57
    Cells(I, 3) = I
    Cells(I, 4).Interior.ColorIndex = I
Next I

End Sub

Hoffe es hilft

Und für den Fall, dass es tatsächlich ohne Anhang sein muss , kommt hier der Code.

Allerdings werden außer Absatzmarken keine weiteren Formatierungsmerkmale übertragen. Andere Schrift oder -größe oder Tabellen oder Unterstriche... fallen weg, bzw werden durch kryptische Zeichen ersetzt. Musst Du ausprobieren: Setz vor das .Send ein Hochkomma und entferne es in der Zeile davor bei .Display, dann kannst Du die Mail betrachten, ohne sie zu senden.

Zudem habe ich die Schleife angepasst, sie liest jetzt nicht eine feste Anzahl Empfänger ein, sondern nur bis zur letzten benutzten Zeile.

Sub Mail_direct()
Dim obj_wdApp As Word.Application
Dim obj_wdDoc As Word.Document
Dim strDocName As String
Dim strMessage
Dim MyOutApp As Object, MyMessage As Object
Dim i As Long

'eine Wordumgebung anbinden
Set obj_wdApp = CreateObject("Word.Application")
'die .Doc öffnen (Pfad & Namen anpassen!)
strDocName = "D:\!Privat\Lustige_Preise.doc"

Set obj_wdDoc = obj_wdApp.Documents.Add(Template:=strDocName)
'allerdings Fenster auf Taskleite verkleinern
obj_wdApp.WindowState = wdWindowStateMinimize
'Sichtbar machen (in die Taskleiste)
obj_wdApp.Visible = True
With obj_wdApp
  ' im Word-Doc an den Anfang gehen     
 .Selection.HomeKey Unit:=wdStory
 ' Das ganze Doc auswählen      
 .Selection.WholeStory
  ' Die Auswahl in eine Variable kopieren
  strMessage = .Selection.FormattedText
  'oder strMessage = .Selection.Text  
  'ist Wurst, da keine Formatierungen übertragen werden
End With

'Start der Sendeschleife an alle Empfänger
For i = 1 To ActiveSheet.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
    Set MyOutApp = CreateObject("Outlook.Application")
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        'Die Empfänger stehen in Spalte A ab Zeile 1
        .To = Cells(i, 1) 'E-Mail Adresse
        'Der Betreff in Spalte B
        .Subject = Cells(i, 2) '"Betreffzeile"
        'Der zu sendende Text in Spalte C
        'Maximal 1024 Zeichen
        'Der Text wird ohne Formatierung übernommen
        .Body = strMessage
        'Hier wird die Mail angezeigt
''        .Display
        'Hier wird die Mail gleich in den Postausgang gelegt
        .Send
    End With


    'Die .doc aus Excel-Sitzung entfernen
    Set obj_wdDoc = Nothing
    'die Word-Instanz aus Excel entfernen (Sonst bleiben Reste in der Taskliste!)
    Set obj_wdApp = Nothing
    'Objectvariablen leeren
    Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
    Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
    'Sendepause einschalten
    'Outlook kann die Aufträge nicht schnell genug verarbeiten
    Application.Wait (Now + TimeValue("0:00:05"))

Next i
End Sub

Hoffe es hilft

Deine Bilder sind nicht lesbar, daher schau mal in diese Anwort, die zeigt, wie man Code als Code eingibt:

http://www.gutefrage.net/frage/word-2010-pfadvorgabe-beim-speichern#answer131238529

Nun zu deinem Problem, versuch es mal mit folgendem Code:

Sub Tagesnamen()
Dim myDatum As Date
Dim MyWochenTag As String
Dim MyAusgabe As String

myDatum = "21.08.2014"

MyWochenTag = Weekday(myDatum, vbSunday)

Select Case MyWochenTag
Case vbSunday
    MyAusgabe = "Sonntag"
Case vbMonday
    MyAusgabe = "Montag"
Case vbTuesday
    MyAusgabe = "Dienstag"
Case vbWednesday
    MyAusgabe = "Mittwoch"
Case vbThursday
    MyAusgabe = "Donnerstag"
Case vbFriday
    MyAusgabe = "Freitag"
Case vbSaturday
    MyAusgabe = "Samstag"
End Select

MsgBox MyAusgabe
End Sub

Bitte um Rückmeldung, ob es das ist, was du suchst

Versuch es mal so:

Private Sub UserForm_Initialize()
'Code von PauleVBA von  w w w .Gutefrage . net 08/2014

Dim LastRow As Long
Dim I As Long
Dim J As Long
ReDim Liste(1) As String
    J = 1
    LastRow = Worksheets("Daten").Range("B:B").End(xlDown).Row
    For I = 1 To LastRow
        If Cells(I, 7) = "nein" Then
            ReDim Preserve Liste(J)
            Liste(J) = Cells(I, 2).Text
            J = J + 1
        End If
    Next I
     ListBox1.List() = Liste()
End Sub

Da ich das äußere With Me.txtDatum... nicht verstehe, habe ich es weg gelassen. Erbitte Rückmeldung, ob es das ist, was du brauchst

Versuch es mal damit:

Sub TeileText()
Dim lng_LastRow As Long
Dim I As Long
Dim J As Long
Dim str_Langtext As String
Dim str_Atext As String
Dim str_Btext As String

lng_LastRow = Range("A:A").SpecialCells _
                 (xlCellTypeLastCell).Row
For I = 1 To lng_LastRow
    str_Langtext = Cells(I, 1)
    For J = 1 To Len(str_Langtext)
        If Mid(str_Langtext, J, 1) = "=" Then
            str_Atext = Left(str_Langtext, J)
            Cells(I, 1) = str_Atext
            str_Btext = Mid(str_Langtext, J + 1, _
                              Len(str_Langtext))
            Cells(I, 2) = CDbl(str_Btext)
        End If
    Next J
Next I
End Sub

Ist zwar kein "Befehl", sondern ein VBA-Code, funzt bei mir aber.

Nun ist es mir selber gelungen ohne das verflixte .Select die Eintragungen vorzunehmen:

Sub all_Linked_D()
Dim I As Long
Dim LinkName As String
For I = 2 To 9
    LinkName = "Tabelle" & I & "!A1" ' Ergibt Tabelle2!A1, Tabelle3!A1.....
    With Sheets("Tabelle1")
        .Hyperlinks.Add Anchor:=Sheets("Tabelle1").Cells(I, 1), Address:="", SubAddress:= _
        LinkName, TextToDisplay:=LinkName
    End With
Next I
End Sub

Das Multiplizieren und danach Summieren geht doch gaaaanz einfach ohne Formel im Blatt nur mit Code:

For I = 15 To LetzteZeile 'I ergibt die Zeile im Blatt
    Cells(I, 2) = Cells(I, 2) * TextBox1 'Multipliziert Zelle in B (...,2) mit Textbox 1
    Cells(I, 3) = Cells(I, 3) * TextBox2 ' dito C (...,3) mit Textbox 2
    Cells(I, 4) = Cells(I, 2) + Cells(I, 3) 'und nun die Summe bilden und in D eintragen
Next I

Musst Du jetzt nur noch einbauen. Und nicht vergessen: Dim I as Long

Wenn es wirklich ein Button im UserForm ist, geht es sehr viel einfacher. Schreibe in die UserForm folgenden Code:

Private Sub UserForm_Initialize()
    CommandButton1.Accelerator = "a"
    'Zugriff über Alt + a
End Sub

Kleiner Nachteil: Du kannst nur Kleinbuchstaben verwenden und es funzt nur mit Alt + Buchstabe (statt Strg + Buchstabe). Großer Vorteil: Du musst den Zahlenwert des "KeyAscii" nicht umständlich ermitteln.

Wenn es schon beim Öffnen des Formulars im Textfeld stehen soll, muss du den Code in in den Code-bereich des Formulars stellen:

Private Sub UserForm_Activate()
TextBox1 = Date
End Sub

Activate ist ein Ereignis der Formulars, auf das man reagieren kann.

Manchmal muss man derartigen Code auch in das Ereignis Initialize einbinden. Da hilft dann nur noch probieren.

Und teilweise werden die Ereignisse nacheinander (in einer festen Reihenfolge) abgearbeitet.

Mehr siehst Du, wenn du im VBA-Editor (Alt-F11) oberhalb des Textes links in das Feld gehst und dort 'Userform" einstellst, dann hast Du rechts daneben die Auswahl der Ereignisse (des UserForms), auf die man reagiern kann.

Also bitte, wir haben hier (als alte Hasen) so unsere Erfahrungen:

Unsere Programmierkenntnisse werden halt oft für Hausaufgaben missbraucht oder gar von Gewerblichen angefordert (neulich jemand von einem Medic-Center, die ja bestimmt genug Geld für einen bezahlten Programmierer hätten).

Da wird man eben vorsichtig

Auch wenn "Dächer berechnen" ja wohl kaum was ist, was Private machen, gehe ich eben mal von einem kleinen Unternehmer oder einer Einzelperson aus und schicke Dir hier nun die beiden Codes für die Button:

Private Sub CommandButton1_Click()
Dim Anzahl As Long
Dim I As Long

Anzahl = Cells(2, 1)
For I = 1 To Anzahl
    Cells(7 + I, 1) = I
Next I
End Sub

Private Sub CommandButton2_Click()
Dim LastCell As Long
Dim LastRow As Long
Dim I As Long
Dim FirstGenerate As Double
Dim FirstContent As Double
Dim J As Long
Dim StartCell As Long

LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
StartCell = 2
For I = 8 To LastRow
    FirstGenerate = Cells(I, 1)
    FirstContent = Cells(I, 2)
    If FirstGenerate > 0 Then
        For J = StartCell To FirstContent + StartCell - 1
            Sheets("Tabelle2").Cells(J, 1) = FirstGenerate
            Sheets("Tabelle2").Cells(J, 2) = J - StartCell + 1
        Next J
    StartCell = StartCell + FirstContent
    End If
Next I
End Sub

Und noch was: wir sind nicht dazu da, den Programmierern die Arbeit weg zu nehmen. Die wollen auch ihr Geld verdienen..

Da hat die Zeitbegrenzung gnadenlos zugeschlagen, deshalb hier nochmals der ganze Text:

Da muss ich mich Oubyi anschließen, es gibt kein Undo, da jeder Befehl des Makros einzeln erscheinen würde. Das war z.B. bei Office 97 noch so. Excel 97 läuft bei mir nämlich zu Testzwecken noch. Da stehen dann die lezten Befehle meines Makros, oft nicht mal alle, was ja dann auch nicht besser war, so kommt man nämlich durch Undo in einen undefinierten Zustand.

Ich umgehe das ganze, in dem ich vor Ausführung des Makros eine Version speichere, auf die ich zurückgreifen kann. Per Makro wird dann aus Inventur.xls eine Speicherung von Inventur_1.xls Aber Vorsicht, man muss dann natürlich wieder in die Urform zurückspringen.

Das ganze habe ich als eigene Sub-Routine programmiert (modular) und kann sie dann mit Call am Anfang eines jeden Makros einsetzen, wenn der Verdacht besteht, dass das Makro nicht das macht was es soll. Hilft zumindest in der Testphase, danach kann das Speichern lästig werden, aber man cann ja einfach das Call auskommetieren.

meinst du es so?

Sub Feld_ins()
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DRUCKDAT ", PreserveFormatting:=True
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "AUTOR ", PreserveFormatting:=True

End Sub

Da meine Kenntnisse mit 2003 enden, kann ich nur raten. Aber vllt geht ja folgendes: Zeichne mal ein Makro auf, was den Recherchiern-Dialog scjhließt. Im Code,bevor Du was anderes machst, diese Befehlsfolge setzen. Dann "blitzt" der Dialog zwar kurz auf, aber ist ggf. wirklich wieder zu. Kann ich nicht ausprobieren, deshalb selbst mal versuchen!

Ich kann zwar nicht nachvollziehen, was du da genau machst. Dazu müsstest du den Code einstellen.

Aber versuch doch mal folgendes: Gleich hinter dem Sub-Befehl vom Sub, das das Password generiert und zum Schluss dieser Routine den Code einfügen:

Sub mein_Sub()
On Error GoTo ERR_PW
'.
'. 'dein Code
'.
Exit Sub
ERR_PW:
ActiveWorkbook.Saved = True
Application.Quit

End Sub

Ganz einfaches Beispiel, muss aber bei Dir angepasst werden:

Sub Daten_Ohne_Makros()
    Windows("UrsprungsMappe").Activate
    Sheets("Tabelle2").Select
    Cells.Select
    Selection.Copy
    Windows("ZielMappe").Activate
    Sheets("Tabelle2").Select
    ActiveSheet.Paste
End Sub

Und so weiter mit allen Blättern ("Tabelle1, 2,3, .....n-1, n") der Mappe . Auf die Benamsung der Mappen und der Blätter achten!

Und beide Mappen müssen geöffnet sein.

Hätte Dir der Makro-Rekorder auch ähnlich aufgezeichnet!

Sudoko-Erzeugung,

Sudoku-Helfer,

Mastermind,

Aus Spalten Zeilen machen und aus Zeilen Spalten (Matrix drehen),

Kassenbuch mit 4-5 Produkten und Auswertung,

"fälschungssicheres" Posteingangsbuch,

EAN_Ptrüfer und erzeuger für EAN-Prüfziffer,

Kniffel-Tabelle mit Hilfen

Bingoschein Erzeugung,

Und ehe du sagst, das geht überwiegend nicht:

Bis auf 1. den Sudoku-Erzeuger hab ich schon alles gemacht.

Du must ein Modul schaffen und dort die Variable deklarieren. Dann ist sie über mehrere UserForms gültig