Longueur ligne de code

[tactic6]

Bonjour le forum
j'ai compilé un bout de code qui doit copier des cellules d'un tableau pour les transcrire sur une ligne d'une autre feuille mais apparement la ligne est trop longue et je ne sais pas comment l'ecrire

For Each cellule In Worksheets("Facture").Range("J6,h5,C12,G8,H9,G10,h12,B15,C15,H15,I15,K15,B16,C16,H16,I16,K16,B17,C17,H17,I17,K17,B18,C18,H18,I18,K18,B19,C19,H19,I19,K19,B20,C20,H20,I20,K20,B21,C21,H21,I21,K21,B22,C22,H22,I22,K22,B23,C23,H23,I23,K23,B24,C24,H24,I24,K24,B25,C25,H25,I25,K25,B26,C26,H26,I26,K26,B27,C27,H27,I27,K27,B28,C28,H28,I28,K28,B29,C29,H29,I29,K29,B30,C30,H30,I30,K30,B31,C31,H31,I31,K31,B32,C32,H32,I32,K32,B33,C33,H33,I33,K33,B34,C34,H34,I34,K34,B35,C35,H35,I35,K35,B36,C36,H36,I36,K36,B37,C37,H37,I37,K37,B38,C38,H38,I38,K38,B39,C39,H39,I39,K39,B40,C40,H40,I40,K40,B41,C41,H41,I41,K41,B42,C42,H42,I42,K42,B43,C43,H43,I43,K43,B44,C44,H44,I44,K44,B45,C45,H45,I45,K45,B46,C46,H46,I46,K46,B47,C47,H47,I47,K47,B48,C48,H48,I48,K48,B49,C49,H49,I49,K49,B50,C50,H50,I50,K50,B51,C51,H51,I51,K51,B52,C52,H52,I52,K52,J54,B55,C55,D55,B56,C56,D56,B57,C57,D57,J55,J56,J57,J58,j59")

le code entier

Sub Transfert()
Dim ligne As Integer
Dim colonne As Byte
Dim cellule As Range

Sheets("facture").Select

If Range("C12").Value = "" Then
MsgBox "Il n' y a pas de nom, la facture ne peut pas être enregistrée"
Exit Sub
End If
If Range("J6").Value = "" Then
MsgBox "Il n' y a pas de numéro, la facture ne peut pas être enregistrée"
Exit Sub
End If
If Range("H5").Value = "Date" Then
MsgBox "Il n' y a pas de Date, la facture ne peut pas être enregistrée"
Exit Sub
End If
ligne = Worksheets("Feuil1").Range("A65536").End(xlUp).Row + 1

For Each cellule In Worksheets("Facture").Range("J6,h5,C12,G8,H9,G10,h12,B15,C15,H15,I15,K15,B16,C16,H16,I16,K16,B17,C17,H17,I17,K17,B18,C18,H18,I18,K18,B19,C19,H19,I19,K19,B20,C20,H20,I20,K20,B21,C21,H21,I21,K21,B22,C22,H22,I22,K22,B23,C23,H23,I23,K23,B24,C24,H24,I24,K24,B25,C25,H25,I25,K25,B26,C26,H26,I26,K26,B27,C27,H27,I27,K27,B28,C28,H28,I28,K28,B29,C29,H29,I29,K29,B30,C30,H30,I30,K30,B31,C31,H31,I31,K31,B32,C32,H32,I32,K32,B33,C33,H33,I33,K33,B34,C34,H34,I34,K34,B35,C35,H35,I35,K35,B36,C36,H36,I36,K36,B37,C37,H37,I37,K37,B38,C38,H38,I38,K38,B39,C39,H39,I39,K39,B40,C40,H40,I40,K40,B41,C41,H41,I41,K41,B42,C42,H42,I42,K42,B43,C43,H43,I43,K43,B44,C44,H44,I44,K44,B45,C45,H45,I45,K45,B46,C46,H46,I46,K46,B47,C47,H47,I47,K47,B48,C48,H48,I48,K48,B49,C49,H49,I49,K49,B50,C50,H50,I50,K50,B51,C51,H51,I51,K51,B52,C52,H52,I52,K52,J54,B55,C55,D55,B56,C56,D56,B57,C57,D57,J55,J56,J57,J58,j59")
colonne = colonne + 1
Worksheets("Feuil1").Cells(ligne, colonne) = cellule
Next cellule
Dim Derli As Long
Derli = Sheets("Feuil1").Columns("I").Find("*", , , , , xlPrevious).Row + 1
Worksheets("Feuil1").Cells(Derli, "I").Value = Now()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End Sub

Merci pour votre aide
et Bon WE à tous

 

[tactic6]

Re : Longueur ligne de code

Bonsoir le forum

tout fonctionne impec merci encore pour votre aide
mais serait il possible de faire en sorte que:
- si une cellule comprise entre C12 et C52 est vide alors une formule rechercheV s'inscrive automatiquement ?

exemple si C31 est vide alors C31 =

=SI(NON(ESTVIDE(B31));RECHERCHEV(B31;'liste des articles'!$A$2:$D$10000;2;FAUX);"")

et I31 deviendrait

=SI(ESTERREUR(RECHERCHEV(B31;'liste des articles'!$A$1:$D$10000;4;FAUX));"";(RECHERCHEV(B31;'liste des articles'!$A$1:$D$10000;4;FAUX)))

en fait quand je rapatrie un devis ou une facture j'aimerais que les cellules non remplies gardent les formules de la feuille où elles sont collées

merci

 

[tactic6]

Re : Longueur ligne de code

Re tout le monde

que pensez vous de ceci et pour chaque cellules ?

Range("C15").Select
    If ("c15") = "" Then
ActiveCell.FormulaLocal = "=SI(NON(ESTVIDE(B15));RECHERCHEV(B15;'liste des articles'!$A$2:$D$10000;2;FAUX);"") "

et faire de même pour c16 .....c52
puis pour I15 jusqu'à I52

EDIT
ça ne fonctionne pas
zut