XL 2016 Problème Macro

[max006]

Bonjour ,

Je suis entrain de crée un formulaire basic ( j'ai un niveau très très bas )

Voici le code :

Sheets("Prod").Range("D2:J2").Select
Selection.Copy
Sheets("Juin").a4 ").End(xlDown).Offset(1, 0).Select"


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Prod").Select
Range("D8:F8").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D11").Select
Selection.ClearContents
Range("F11").Select
Selection.ClearContents
Range("F14").Select
Selection.ClearContents
Range("F17").Select
Selection.ClearContents
Range("D14").Select
Selection.ClearContents
Range("D17").Select
Selection.ClearContents
End Sub

La macro fonctionne bien mais par contre elle ne va pas a la ligne suivante dans mon classeur , aurez vous des idées ?
Merci d'avance

 

[ChTi160]

Bonjour Max006

bien venue sur Xld
il faut savoir que travaillé sur un fichier aide beaucoup les intevenants

prmeire demande
cette Ligne fonctionne dans ton fichier ?

Sheets("Juin").a4 ").End(xlDown).Offset(1, 0).Select"

il me semble qu'il y a un problème !
ce serait mieux ainsi

Sheets("Juin").Range("a4").End(xlDown).Offset(1, 0).Select

Bonne journée
jean marie

 

[max006]

Merci pour ta réponse,
oui désole j'ai oubliais de mettre le fichier , le voici .
J'ai essayé le code que tu m'a donné cela n'a pas changer

 

[ChTi160]

Re
normal je n'est rien changé juste signalé ce qui me semblait incorrecte sur cette Ligne de code !
pas évident sans fichier !
Bonne journée
jean marie

 

[max006]

Re
normal je n'est rien changé juste signalé ce qui me semblait incorrecte sur cette Ligne de code !
pas évident sans fichier !
Bonne journée
jean marie

Oui j'ai mis le fichier dans ma réponse.
Merci pour ton aide

 

[cathodique]

Bonjour max006, Chti160,

Evite les 'Select' / 'Selection'.

Quel est ton objectif final?

A+

 

[max006]

Bonjour max006, Chti160,

Evite les 'Select' / 'Selection'.

Quel est ton objectif final?

A+

Hello, Mon objectif et juste de remplir un tableau en passant par un formulaire ++

 

[Phil69970]

Bonjour @max006 , @ChTi160 , @cathodique , le forum

Je te propose ceci:

Sub Macro11()
Application.ScreenUpdating = False
Dim Derlig&
Derlig = Worksheets("Juin").Cells(Worksheets("Juin").Rows.Count, "A").End(xlUp).Row + 1
 
Sheets("Prod").Range("D2:J2").Copy
Worksheets("Juin").Range("A" & Derlig).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
 
Sheets("Prod").Range("D8:F8,D11,D14,D17,F11,F14,F17").ClearContents

End Sub

@Phil69970

 

[cathodique]

Hello, Mon objectif et juste de remplir un tableau en passant par un formulaire ++

D'après ce que j'ai compris, j'ai fait un ménage dans ton code.
à tester

Sub Macro11()
Dim dl As Long
    dl = Sheets("Juin").Cells(Rows.Count, 1).End(xlUp).Row + 1

'    Sheets("Prod").Range("D2:J2").Copy Sheets("Juin").Range("A" & dl)
'    Sheets("Prod").Range("D8:F8").ClearContents
'    Sheets("Prod").Range("D11").ClearContents
'    Sheets("Prod").Range("F11").ClearContents
'    Sheets("Prod").Range("F14").ClearContents
'    Sheets("Prod").Range("F17").ClearContents
'    Sheets("Prod").Range("D14").ClearContents
'    Sheets("Prod").Range("D17").ClearContents

'ou bien

With Sheets("Prod")
.Range("D2:J2").Copy Sheets("Juin").Range("A" & dl)
.Range("D8:F8").ClearContents
.Range("D11").ClearContents
.Range("F11").ClearContents
.Range("F14").ClearContents
.Range("F17").ClearContents
.Range("D14").ClearContents
.Range("D17").ClearContents
End With
End Sub

A+

edit: Salut @Phil69970

 

[Phil69970]

Re

@cathodique
*Pour nettoyer toutes les cellules en même temps une ligne de code suffit😉

Sheets("Prod").Range("D8:F8,D11,D14,D17,F11,F14,F17").ClearContents

*Ta copie n’enlèves pas le format comme @max006 le souhaite

Selection.PasteSpecial Paste:=xlPasteValues

@Phil69970

 

[max006]

D'après ce que j'ai compris, j'ai fait un ménage dans ton code.
à tester

Sub Macro11()
Dim dl As Long
    dl = Sheets("Juin").Cells(Rows.Count, 1).End(xlUp).Row + 1

'    Sheets("Prod").Range("D2:J2").Copy Sheets("Juin").Range("A" & dl)
'    Sheets("Prod").Range("D8:F8").ClearContents
'    Sheets("Prod").Range("D11").ClearContents
'    Sheets("Prod").Range("F11").ClearContents
'    Sheets("Prod").Range("F14").ClearContents
'    Sheets("Prod").Range("F17").ClearContents
'    Sheets("Prod").Range("D14").ClearContents
'    Sheets("Prod").Range("D17").ClearContents

'ou bien

With Sheets("Prod")
.Range("D2:J2").Copy Sheets("Juin").Range("A" & dl)
.Range("D8:F8").ClearContents
.Range("D11").ClearContents
.Range("F11").ClearContents
.Range("F14").ClearContents
.Range("F17").ClearContents
.Range("D14").ClearContents
.Range("D17").ClearContents
End With
End Sub

A+

edit: Salut @Phil69970

Ca fonctionne c'est PARFAIT merciiiii
Par contre pour mettre un collage en valeur je peux le rajouter ?

 

[cathodique]

Re

@cathodique
*Pour nettoyer toutes les cellules en même temps une ligne de code suffit😉

Sheets("Prod").Range("D8:F8,D11,D14,D17,F11,F14,F17").ClearContents

*Ta copie n’enlèves pas le format comme @max006 le souhaite


@Phil69970

Je te remercie pour ton retour.
Je suis resté dans le basique plus qu'il nous disait dans son 1er post :"j'ai un niveau très très bas"
J'ai vu aussi qu'il n'y avait aucune mise en forme, d'où mon utilisation de 'Copy'.

Encore merci.

Bonne journée.

 

[Phil69970]

@max006

As tu lu mon post #8 ?
Merci de ton retour.

@Phil69970

 

[max006]

@max006

As tu lu mon post #8 ?
Merci de ton retour.

@Phil69970

Yes c'est juste ceux qui me fallait merci beaucoup pour l'aide

 

[cathodique]

Pour le fun, pour ne plus passer par une ligne intermédiaire.

Option Explicit

Sub Macro12()
'en utilisant un Array Tb, plus la peine de passer par la 2ème de la feuille 'prod'
    Dim dl As Long, Tb(6)
    Application.ScreenUpdating = False
    dl = Sheets("Juin").Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Prod")
        Tb(0) = .Range("D8").Value
        Tb(1) = .Range("D11").Value
        Tb(2) = .Range("F11").Value
        Tb(3) = .Range("D14").Value
        Tb(4) = .Range("F14").Value
        Tb(5) = .Range("D17").Value
        Tb(6) = .Range("F17").Value
        Sheets("Juin").Range("A" & dl).Resize(1, UBound(Tb) + 1).Value = Tb
        .Range("D8:F8,D11,D14,D17,F11,F14,F17").ClearContents
    End With
        Application.ScreenUpdating = False
End Sub