Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 17:57:35
Zellen-Name aus A1 nach H1 übertragen mit Prä- + Suffix
17.10.2025 11:36:58
verschachteltes Dropdown-Menü
17.10.2025 10:28:49
Call Anweisung
16.10.2025 18:38:17
Zusammenfassung nach Personalnummer
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
800to804
800to804
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bitte um Makro Erweiterung

Forumthread: Bitte um Makro Erweiterung

Bitte um Makro Erweiterung
10.09.2006 20:45:37
Heinz
Hallo Leute
Habe im unteren Makro,das mir Werte in die richtige Spielrunde einträgt.
Funkt. auch einwandfrei.
Nur möchte ich jetzt noch zusätzlich das es vor einfügen der Daten nachsieht,ob in Zelle D4 schon ein Wert steht.
Wenn kein Wert in D4,dann einfügen. Sonst eine Msg Abfrage "Daten sind schon eingefügt. Überschreiben Ja oder Nein."
Könnte mir Bitte das Makro jemand erweitern ?
Danke Heinz

Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 40
If WorksheetFunction.CountIf(Range("D4:D15"), i) >= 1 Then
Range("B4:K15").Copy
'If i < 10 Then i = "0" & i
Sheets("R" & CStr(i)).Range("B4").PasteSpecial Paste:=xlValues
Range("C18:D29").Copy
Sheets("R" & CStr(i)).Range("C18").PasteSpecial Paste:=xlValues
Range("F23:J37").Copy
Sheets("R" & CStr(i)).Range("N2").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Exit For
End If
Next i
End Sub

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bitte um Makro Erweiterung
10.09.2006 22:24:00
Ramses
Hallo
probiers mal

Private Sub CommandButton1_Click()
Dim i As Integer
Dim Qe as Integer
If not isempty(Range("D4")) Then
Qe = Msgbox("Daten sind schon eingefügt." & vbcrlf & "Überschreiben Ja oder Nein ?", vbQuestion+vbyesno,"Frage")
If Qe = vbno then Exit sub
End If
For i = 1 To 40
If WorksheetFunction.CountIf(Range("D4:D15"), i) >= 1 Then
Range("B4:K15").Copy
'If i < 10 Then i = "0" & i
Sheets("R" & CStr(i)).Range("B4").PasteSpecial Paste:=xlValues
Range("C18:D29").Copy
Sheets("R" & CStr(i)).Range("C18").PasteSpecial Paste:=xlValues
Range("F23:J37").Copy
Sheets("R" & CStr(i)).Range("N2").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Exit For
End If
Next i
End Sub

Gruss Rainer
Anzeige
AW: Bitte um Makro Erweiterung
11.09.2006 13:47:51
Heinz
Hallo Rainer
Habe Deinen Code getestet.
Läuft Super.
Recht herzlichen Dank.
Gruss, Heinz
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige