Bonjour
J'ai mis en place un macro qui devrait copier une fiche dans un nouvel onglet avec attribution d'un nom, en même temps enregistrer dans une base de donnée les éléments de cette fiche.
Cela a fonctionné et tout à coup la fiche copiée et enregistrée et toujours la même, elle se copie et enregistre même dans les copie et enregistrement précédent.
Je n'y comprend plus rien.
De plus nous sommes dimanche soir et e devait finir tout cela pour demain,
je vous joins cette macro rebelle, si quelqu'un peut m'aider!!! ce serait super, merci.
Etienne
Sub creatfeuille()
Dim sh As Worksheet
Dim i As Integer
Dim NomF As String
' recherche du numéro
On Error Resume Next
If Err > 0 Then Err.Clear
For i = 1 To 100
Sheets(i).Activate
' numéro trouvé
If Err.Number > 0 Then Exit For
Next i
With Sheets("Relevtriproptype")
.Copy after:=Sheets(Sheets.Count - 1)
'Nomme la nouvelle feuille avec le nom contenu en C6 de Sheets("RECAP")
ActiveSheet.Name = Sheets("RECAP").Range("C6").Value
'Ajout du numéro de facture dans la nouvelle feuille
ActiveSheet.Range("F18;G18;H18") = "Facture N°" & Sheets("RECAP").Range("C6").Value
'Mémorisation du nom de la dernière feuille pour l'utiliser en tant qu'hyperlien plus bas
NomF = ActiveSheet.Name
End With
With Sheets("Recap")
Dim dl1 As Long ' dernière ligne
dl1 = .Range("a65536").End(xlUp).Row + 1
'création du lien hypertext dans la feuille RECAP en prenant le nom de la dernière feuille créée
.Range("C" & dl1).Hyperlinks.Add Anchor:=.Range("C" & dl1), Address:="", SubAddress:= _
"'" & NomF & "'!A1", TextToDisplay:=NomF
.Range("a" & dl1).Value = i
'Incrémentation pour la prochaine facture
.Range("C6").Value = .Range("C6").Value + 1
'Inscription des formules dans la feuille RECAP
'pour récupérer les données des factures
.Range("K" & dl1) = "=" & Sheets(NomF).Name & "!F14" 'Inscription Date
.Range("D" & dl1) = "=" & Sheets(NomF).Name & "!F20" 'Réf Clt
.Range("E" & dl1) = "=" & Sheets(NomF).Name & "!Q14" 'Statut
.Range("F" & dl1) = "=" & Sheets(NomF).Name & "!F18" 'Période
.Range("G" & dl1) = "=" & Sheets(NomF).Name & "!Q16" 'Nom
.Range("H" & dl1) = "=" & Sheets(NomF).Name & "!Q18" 'Adresse
.Range("I" & dl1) = "=" & Sheets(NomF).Name & "!Q20" 'CP
.Range("J" & dl1) = "=" & Sheets(NomF).Name & "!S20" 'Ville
.Range("L" & dl1) = "=" & Sheets(NomF).Name & "!Z62" 'Débit TTC
.Range("M" & dl1) = "=" & Sheets(NomF).Name & "!Z63" 'Crédit TTC
.Range("N" & dl1) = "=" & Sheets(NomF).Name & "!Z64" 'Solde propriétaire TTC
.Range("O" & dl1) = "=" & Sheets(NomF).Name & "!I62" 'Frais de gestion HT
.Range("P" & dl1) = "=" & Sheets(NomF).Name & "!I63" 'TVA s/frais de gestion
.Range("Q" & dl1) = "=" & Sheets(NomF).Name & "!I64" 'Frais de gestion TTC
End With
End Sub
J'ai mis en place un macro qui devrait copier une fiche dans un nouvel onglet avec attribution d'un nom, en même temps enregistrer dans une base de donnée les éléments de cette fiche.
Cela a fonctionné et tout à coup la fiche copiée et enregistrée et toujours la même, elle se copie et enregistre même dans les copie et enregistrement précédent.
Je n'y comprend plus rien.
De plus nous sommes dimanche soir et e devait finir tout cela pour demain,
je vous joins cette macro rebelle, si quelqu'un peut m'aider!!! ce serait super, merci.
Etienne
Sub creatfeuille()
Dim sh As Worksheet
Dim i As Integer
Dim NomF As String
' recherche du numéro
On Error Resume Next
If Err > 0 Then Err.Clear
For i = 1 To 100
Sheets(i).Activate
' numéro trouvé
If Err.Number > 0 Then Exit For
Next i
With Sheets("Relevtriproptype")
.Copy after:=Sheets(Sheets.Count - 1)
'Nomme la nouvelle feuille avec le nom contenu en C6 de Sheets("RECAP")
ActiveSheet.Name = Sheets("RECAP").Range("C6").Value
'Ajout du numéro de facture dans la nouvelle feuille
ActiveSheet.Range("F18;G18;H18") = "Facture N°" & Sheets("RECAP").Range("C6").Value
'Mémorisation du nom de la dernière feuille pour l'utiliser en tant qu'hyperlien plus bas
NomF = ActiveSheet.Name
End With
With Sheets("Recap")
Dim dl1 As Long ' dernière ligne
dl1 = .Range("a65536").End(xlUp).Row + 1
'création du lien hypertext dans la feuille RECAP en prenant le nom de la dernière feuille créée
.Range("C" & dl1).Hyperlinks.Add Anchor:=.Range("C" & dl1), Address:="", SubAddress:= _
"'" & NomF & "'!A1", TextToDisplay:=NomF
.Range("a" & dl1).Value = i
'Incrémentation pour la prochaine facture
.Range("C6").Value = .Range("C6").Value + 1
'Inscription des formules dans la feuille RECAP
'pour récupérer les données des factures
.Range("K" & dl1) = "=" & Sheets(NomF).Name & "!F14" 'Inscription Date
.Range("D" & dl1) = "=" & Sheets(NomF).Name & "!F20" 'Réf Clt
.Range("E" & dl1) = "=" & Sheets(NomF).Name & "!Q14" 'Statut
.Range("F" & dl1) = "=" & Sheets(NomF).Name & "!F18" 'Période
.Range("G" & dl1) = "=" & Sheets(NomF).Name & "!Q16" 'Nom
.Range("H" & dl1) = "=" & Sheets(NomF).Name & "!Q18" 'Adresse
.Range("I" & dl1) = "=" & Sheets(NomF).Name & "!Q20" 'CP
.Range("J" & dl1) = "=" & Sheets(NomF).Name & "!S20" 'Ville
.Range("L" & dl1) = "=" & Sheets(NomF).Name & "!Z62" 'Débit TTC
.Range("M" & dl1) = "=" & Sheets(NomF).Name & "!Z63" 'Crédit TTC
.Range("N" & dl1) = "=" & Sheets(NomF).Name & "!Z64" 'Solde propriétaire TTC
.Range("O" & dl1) = "=" & Sheets(NomF).Name & "!I62" 'Frais de gestion HT
.Range("P" & dl1) = "=" & Sheets(NomF).Name & "!I63" 'TVA s/frais de gestion
.Range("Q" & dl1) = "=" & Sheets(NomF).Name & "!I64" 'Frais de gestion TTC
End With
End Sub