Re : Création automatique de nouvelles feuilles factures
Bonsoir
Merci JP pour ta réponse. J'avance tout doucement.
Pour actualiser mes ifférentes données, jessaie d'adapter un cde que j'ai trouvé dans le forum mais je bloque un peu beaucoup.
Merci beaucoup
Bonne soirée
Voilà le code :
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As range)
Dim i As Long
Dim lig As Long
Dim lidep2 As Long
Dim lidep1 As Long
Dim nomfeuille1 As String
Dim col1 As String
Dim col2 As String
Dim col3 As String
Dim col4 As String
Dim col5 As String
Dim col6 As String
Dim range("J1") As String
Dim range("H10") As String
Dim range("J31") As String
Dim range("J33") As String
Dim range("J35") As String
Dim range As String
Dim col6 As String
Dim col6 As String
Dim col6 As String
Dim col6 As String
Dim data1 As String
Dim data2 As String
Dim Sh As Worksheet
Dim ad As String
'**********************************************
' paramétrage
'feuille récapitulaive
nomfeuille1 = "Récapitulatif 2009"
col2 = "c" ' date
col3 = "d" ' colonne nom
col4 = "e" 'colonne montant hors taxe
col5 = "f" ' colonne montant tva
col6 = "g" ' colonne montant ttc
lidep2 = 8 ' ligne départ
' feuille
range("J1") = "O" 'cellule qui contient la date
range("H10") = "P" 'cellule qui contient le nom
range("J31") = "Q" 'cellule qui contient le montant hors taxe
range("J33") = "R" 'cellule qui contient le montant tva
range("J35") = "S" 'cellule qui contient le montant ttc
' fin de paramètrage
For Each Sh In Worksheets
data1 = Sh.Name
If data1 <> "Récapitulatif 2009" Then
With Sheets(data1)
For i = lidep1 To .range(col3 & "65536").End(xlUp).Row
data2 = .range(col3 & i)
If data2 <> "" Then
If IsNumeric(.range(col4 & i)) Then
lig = recherchemot(ad, data2, nomfeuille1, 1)
If lig <> 0 Then
Sheets(nomfeuille1).range(col2 & lig) = Sheets(nomfeuille1).range(col2 & lig) + .range("J1" & i)
Sheets(nomfeuille1).range(col3 & lig) = Sheets(nomfeuille1).range(col3 & lig) + .range("H10" & i)
Sheets(nomfeuille1).range(col4 & lig) = Sheets(nomfeuille1).range(col4 & lig) + .range("J31" & i)
Sheets(nomfeuille1).range(col5 & lig) = Sheets(nomfeuille1).range(col5 & lig) + .range("J33" & i)
Sheets(nomfeuille1).range(col6 & lig) = Sheets(nomfeuille1).range(col6 & lig) + .range("J35" & i)
Else
Select Case MsgBox("Dans la feuille : & data 1" _
& vbCrLf & "" _
& vbCrLf & "le nom " & data2 & " n'existe pas" _
& vbCrLf & "" _
& vbCrLf & "Voulez-vous le créer" _
, vbYesNo Or vbInformation Or vbDefaultButton1, Application.Name)
Case vbYes
lig = Sheets(nomfeuille1).range(col1 & "65536").End(xlUp).Row + 1
Sheets(nomfeuille1).range(col1 & lig) = data2
Sheets(nomfeuille1).range(col2 & lig) = .range(col4 & i)
Case vbNo
End Select
End If
End If
End If
Next i
End With
End If
Next Sh
End Sub
'---------------------------------------------------------------------------------------
' Procedure : recherchemot
' DateTime : 30/06/2007 20:35
' Author : jp14
' Pour : Ce lien n'existe plus
' Utilisation :
' dim lig as long
'lig =recherchemot(plage_pour la recherche,valeur_cherché,nom_de_la_feuille, code_retour )
' ad plage de recherche
'ad = "a2:" & Sheets("rue").Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0) ' on recherche dans l'ensemble de la feuille
'recherchemot(plage_recherche , valcherche , nom_de_la_feuille , code_retour )
'---------------------------------------------------------------------------------------
'
Private Function recherchemot(plage_recherche As String, valcherche As String, nom_de_la_feuille As String, code_retour As Byte)
Dim firstAddress As String
Dim cel As range
Dim ligne1 As Long
Dim ligne2 As Long
With Sheets(nom_de_la_feuille).range(plage_recherche)
Set cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByRows, lookat:=xlWhole) ' on recherche ligne par ligne
'Set c = .Find(valcherche, LookIn:=xlFormulas, SearchOrder:=xlByRows) 'si date
'Set £c = .Find(dataf, LookIn:=xlValues, MatchCase:=True, _
SearchOrder:=xlByRows, lookat:=xlWhole)
If Not cel Is Nothing Then
If code_retour = 1 Then recherchemot = cel.Row
If code_retour = 2 Then recherchemot = cel.Address
Exit Function
End If
End With
recherchemot = 0
End Function
End Function
