Creare una macro per inserimento appuntamenti

[cavaliere123]

Creare una macro per inserimento appuntamenti
Salve a tutti, è da moltissimo che non pongo più domande... ma adesso mi tocca

Arrivando subito al dunque ho creato in excel un calendario per appuntamenti e le date di tutto l'anno sono messe una sotto l'altra. per intenderci cosi :

DATA GIORNO ORA INTERESSATO LUOGO MOTIVO DESTINATARIO
1-gen Martedi
2-gen Mercoledi
3-gen Giovedi
3-gen Giovedi
4-gen Venerdi
5-gen Sabato
6-gen Domenica
7-gen Lunedi

chiaramente in celle diverse, adesso desidero creare una macro con pulsante che se ad esempio mi trovo sulla cella del Mercoledì mi inserisca una riga sotto con la stessa data. per un nuovo inserimento, sempre per chiarezza se attivo la macro deve venirmi così :


DATA GIORNO ORA INTERESSATO LUOGO MOTIVO DESTINATARIO
1-gen Martedi
2-gen Mercoledi
---> 2-gen Mercoledi
3-gen Giovedi
3-gen Giovedi
4-gen Venerdi
5-gen Sabato
6-gen Domenica
7-gen Lunedi

E posso inserire solo 10 righe per ogni data, cioè in effetti massimo dieci appuntamenti al giorno...
Chiaramente ho cercato di fare questa macro che valga per tutte le celle e quindi :

Sub RIGAX() 
' 
'RIGAX Macro 
' 
' 
For x = 0
If x = 9 Then Exit Sub '
a = 12 
y = 13     ( 13 è la riga da cui parte l'elenco nel mio foglio)
Z = y + x
b = a + x 
Rows(Z & ":" & Z).Select 
Selection.Insert Shift:=xlDown 
Range(Cells("B", b), Cells("C" , b)).Select 
Selection.Copy 
Range("B" & b).Select 
ActiveSheet.Paste ActiveSheet.Paste Application.CutCopyMode = False 
Range("D" & Z).Select 
x = x + 1
End Sub

questa macro in effetti, prima inserisce la riga sotto alla cella del giorno selezionato e poi copia il contenuto della cella del giorno e la incolla nella riga inserita, così da avere già scritta anche la data....
Bene... chiaramente come al solito qualcosa ho errato... vi ricordo scusandomi che non sono un esperto chiaramente....
Vi ringrazio anticipatamente se qualcuno sarà così gentile da aiutarmi...
Grazie e buona giornata da Domenico.

 

[cavaliere123]

Per terminare....

Per correttezza posto la procedura completamente rivista, grazie all'aiuto di un esperto trovato in atri gruppi...
Credo che sia più che corretto divulgare ciò che si fa, in special modo se prima si è chiesto

Ecco la procedura :

Sub Macro1()
'
' Macro1 Macro
'

'
    w = Cells(Selection.Row, Selection.Column).Column
    If w <> 1 Then Exit Sub '
    If Cells(Selection.Row, 1).Value = Cells(Selection.Row + 1, 1).Value Then Exit Sub '
     cont = 1
     For x = 14 To Cells(Selection.Row, 1).Row
     valore_celle = Cells(x, 1).Value
     If valore_celle = Cells(Selection.Row, 1).Value Then
     cont = cont + 1
     End If
    Next
     If cont > 3 Then Exit Sub '
     Rows(Selection.Row + 1).Insert Shift:=xlDown
        Cells(Selection.Row + 1, 1) = Selection
        Cells(Selection.Row + 1, 2) = Selection.Offset(, 1)
End Sub