XL 2010 aide sur complément code

[tinet]

Bonjour le forum,

Je cherche à modifier mon code pour copier uniquement la valeur.

Voici mon code

Sub Duplication()


Dim LigneDuplic As Long
Dim NbCopie As Long

With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Feuille jour")
.Range("A6:H1000").ClearContents

LigneDuplic = 6

For i = 6 To Range("A65536").End(xlUp).Row
Sheets("Etapes jour").Select
NbCopie = Cells(i, 1)
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Copy
Sheets("Feuille jour").Select
Range(Cells(LigneDuplic, 1), Cells(LigneDuplic + NbCopie, 1)).Select
ActiveSheet.Paste

LigneDuplic = LigneDuplic + NbCopie

Next i

End With

With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

 

[mutzik]

bonjour
For i = 6 To Range("A65536").End(xlUp).Row
remplacer par Range("A" & rows.count).end ...
rows.count donne le nombre de lignes max de la version excel utilisée et donc fonctionnera partout

remplacer :
Sheets("Etapes jour").Select
NbCopie = Cells(i, 1)
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Copy
Sheets("Feuille jour").Select
Range(Cells(LigneDuplic, 1), Cells(LigneDuplic + NbCopie, 1)).Select
ActiveSheet.Paste
LigneDuplic = LigneDuplic + NbCopie

with Sheets("Etapes jour")
NbCopie = .Cells(i, 1) 'le point devant cells indique qu'il faut utiliser sheets("Etapes Jour")
.Range(Cells(i, 1), Cells(i, 6)).Copy destination:=Sheets("Feuille jour"). _
Range(Cells(LigneDuplic, 1), Cells(LigneDuplic + NbCopie, 1))
LigneDuplic = LigneDuplic + NbCopie
end with

 

[tinet]

Bonjour Mutzik

Merci pour ton retour
Si j'ai bien compris

Sub Duplication()


Dim LigneDuplic As Long
Dim NbCopie As Long

With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Feuille jour")
.Range("A6:H1000").ClearContents

LigneDuplic = 6


For i = 6 To Range("A" & Rows.Count).End(xlUp).Rows.Count


With Sheets("Etapes jour")
NbCopie = .Cells(i, 1) 'le point devant cells indique qu'il faut utiliser sheets("Etapes Jour")
.Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Sheets("Feuille jour"). _
Range(Cells(LigneDuplic, 1), Cells(LigneDuplic + NbCopie, 1))
LigneDuplic = LigneDuplic + NbCopie
End With


Next i

End With

With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

 

[tinet]

Rectif

For i = 6 To Range("A" & Rows.Count).End(xlUp).Row

 

[tinet]

plantage

With Sheets("Etapes jour")
NbCopie = .Cells(i, 1) 'le point devant cells indique qu'il faut utiliser sheets("Etapes Jour")
.Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=Sheets("Feuille jour"). _
Range(Cells(LigneDuplic, 1), Cells(LigneDuplic + NbCopie, 1))
LigneDuplic = LigneDuplic + NbCopie
End With

 

[mutzik]

re,

merci de fournir un extrait de fichier ...

 

[tinet]

Bonjour Mutzik,

Fais autrement merci quand même