Sauvegarder a la suite

Le 16/04/2015 à 21:45

bonsoir a tous

je copie les cellules

b4 c4 e5 d31 e31

en feuille de récapitulation

puis efface en feuille 20011

puis je rempli a nouveau mon tableau

pour recopier

b4 c4 e5 d31 e31

en feuille de récapitulation

mais a la suite sans effacer mais première donnée et la je bloque

voir pièce jointe

aiglon74

11classeur-diamant.xlsm (27.48 Ko)

Le 17/04/2015 à 08:02

Bonjour Aiglon, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim OS As Worksheet
Dim OD As Worksheet
Dim DEST As Range

Application.ScreenUpdating = False
Set OS = Sheets("20011")
Set OD = Sheets("Récapitulatif")
Set DEST = OD.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1,0)
OS.Unprotect
OS.Range("B4").Copy DEST
OS.Range("C4").Copy DEST.Offset(0, 1)
OS.Range("D31").Copy DEST.Offset(1, 0)
OS.Range("E31").Copy DEST.Offset(1, 1)
OS.Range("E5").Copy DEST.Offset(-1, 0)
OS.Range("E8:E30").ClearContents
OS.Range("B8:B30").ClearContents
Application.ScreenUpdating = True
OS.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Le 19/04/2015 à 11:50

merci

pour ta réponse

Dim OS As Worksheet

Dim OD As Worksheet

Dim DEST As Range

Application.ScreenUpdating = False

Set OS = Sheets("20011")

Set OD = Sheets("Récapitulatif")

Set DEST = OD.Cells(Application.Rows.Count, 3).End(xlUp).Offset(4, 0)

OS.Unprotect

OS.Range("B4").Copy DEST

OS.Range("C4").Copy DEST.Offset(0, 1)

OS.Range("D31").Copy DEST.Offset(1, 0)

OS.Range("E31").Copy DEST.Offset(1, 1)

OS.Range("E5").Copy DEST.Offset(-1, 0)

OS.Range("E8:E30").ClearContents

OS.Range("B8:B30").ClearContents

'efface les cellules

Sheets("20011").Activate

mais je voudrais la valeur de la cellule non pas le format de celle ci

mais dans le fonctionnement tip top

aiglon74

Le 19/04/2015 à 22:38

bonsoir a tous( ThauThème)

voici ma solution ca marche super

Sub Macro1()

Dim OS As Worksheet

Dim OD As Worksheet

Dim DEST As Range

Application.ScreenUpdating = False

Set OS = Sheets("20011")

Set OD = Sheets("Récapitulatif")

Set DEST = OD.Cells(Application.Rows.Count, 3).End(xlUp).Offset(4, 0)

OS.Unprotect

OS.Range("B4").Copy

DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

OS.Range("C4").Copy

DEST.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

OS.Range("D31").Copy

DEST.Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

OS.Range("E31").Copy

DEST.Offset(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

OS.Range("E5").Copy

DEST.Offset(-1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _

xlNone, SkipBlanks:=False, Transpose:=False

'OS.Range("E8:E30").ClearContents

'OS.Range("B8:B30").ClearContents

'efface les cellules

Sheets("20011").Activate

Application.ScreenUpdating = False

ActiveSheet.[e8] = ""

ActiveSheet.[e9] = ""

ActiveSheet.[e10] = ""

ActiveSheet.[e11] = ""

ActiveSheet.[e12] = ""

ActiveSheet.[e13] = ""

ActiveSheet.[e14] = ""

ActiveSheet.[e15] = ""

ActiveSheet.[e16] = ""

ActiveSheet.[e17] = ""

ActiveSheet.[e18] = ""

ActiveSheet.[e19] = ""

ActiveSheet.[e20] = ""

ActiveSheet.[e21] = ""

ActiveSheet.[e22] = ""

ActiveSheet.[e23] = ""

ActiveSheet.[e24] = ""

ActiveSheet.[e25] = ""

ActiveSheet.[e26] = ""

ActiveSheet.[e27] = ""

ActiveSheet.[e28] = ""

ActiveSheet.[e29] = ""

ActiveSheet.[e30] = ""

ActiveSheet.[b8] = ""

ActiveSheet.[b9] = ""

ActiveSheet.[b10] = ""

ActiveSheet.[b11] = ""

ActiveSheet.[b12] = ""

ActiveSheet.[b13] = ""

ActiveSheet.[b14] = ""

ActiveSheet.[b15] = ""

ActiveSheet.[b16] = ""

ActiveSheet.[b17] = ""

ActiveSheet.[b18] = ""

ActiveSheet.[b19] = ""

ActiveSheet.[b20] = ""

ActiveSheet.[b21] = ""

ActiveSheet.[b22] = ""

ActiveSheet.[b23] = ""

ActiveSheet.[b24] = ""

ActiveSheet.[b25] = ""

ActiveSheet.[b26] = ""

ActiveSheet.[b27] = ""

ActiveSheet.[b28] = ""

ActiveSheet.[b29] = ""

ActiveSheet.[b30] = ""

Application.ScreenUpdating = True

OS.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

MERCI A ThauThème

A+

Le 19/04/2015 à 22:55

Bonsoir Aiglon, bonsoir le forum,

Par pitié !... Remplace toutes les lignes d'effacement (ActiveSheet.[e8] = ""...) par :

With ActiveSheet
     .Range("E8:E30").ClearContents
     .Range("B8:B30").ClearContents
End With

Le 20/04/2015 à 17:53

Bonsoir ThauThème Bonsoir a tous

With ActiveSheet

.Range("E8:E30").ClearContents

.Range("B8:B30").ClearContents

End With

ne fonctionne pas ca bloque avec le code en feuille 1

j'avais déjà essayer je pige pas

A+

Le 20/04/2015 à 19:21

Bonsoir Aiglon, bonsoir le forum,

En fait, il faut faire comme dans ma première proposition. Passer par des variables de type WorkSheet et ensuite utiliser les variable plutôt que Activesheet. Tu verras il n'y aura pas de problème...