Help Me - VBA excel , tout simple mais j y arrive pas

[AKSooL]

BOnjour , je voudrais faire un truc tout simple mais il me bug toujours sur la ligne selection.copy

Je voudrais copier differente cellule d une feuille (datacollection), pour la mettre en ligne dans un tableau feuille(archive) - j arrive a selectionner mais il me copie rien.
2eme point, apres le 1er enregistrement ,il efface le formulaire( de datacollection) on remet des datas , et je voudrais qu il copie dans la 2eme ligne du tableau.

voici le debut de mon code ( honte a moi )

Private Sub Save_Click() 'au clic sur "Enregistrer données"
'si "Oui" au message, les cellules seront enregistrées

Sheets("Datacollection").Select 'selectionner la feuille a copier
Range("D12,C5:C6,E5,B10:B13,E16:E23,B26:B37,D3940,C42,C43,E42,B48:B59,E65:E73,B78:B87,C78:C87,E78:E87,B92:B102,C92:C102,E92:E102,E105:E109").Select
Selection.Copy
Sheets("Archive").Select 'Feuille archive
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub


Merci

 

[Compte Supprimé 979]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

Salut Aksool,

Excel ne sait pas copier/coller des cellules discontinues pffft

If faut le faire par étapes

Option Explicit
Private Sub Save_Click() 'au clic sur "Enregistrer données"
'si "Oui" au message, les cellules seront enregistrées
Dim ShtDC As Worksheet, ShtA As Worksheet
Set ShtDC = Sheets("Datacollection")
Set ShtA = Sheets("Archive")
' Copier / coller les cellules contigues
ShtDC.Range("D1:D2").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("C5:C6").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E5").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("B10:B13").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E16:E23").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("B26:B37").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("D39:D40").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("C42").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("C43").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E42").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("B48:B59").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E65:E73").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("B78:B87").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("C78:C87").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E78:E87").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("B92:B102").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("C92:C102").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E92:E102").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ShtDC.Range("E105:E109").Copy
ShtA.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial _
  Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Effacer les variables objet
Set ShtDC = Nothing
Set ShtA = Nothing
End Sub

Voilà

 

[AKSooL]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

merci pour la reponse rapide

Qd je compile , il me dit que : seuls des commentaires peuvent apparaitre apres end sub , end function , ...

C koi ca ??
sinon c koi ton option explicite

Ca marche , mais juste un probleme ( j ai du mal m exprimer aussi )
une fois qu il a rempli la colonne B avec tous les elements , la prochaine copie se fera dans la colonne C , et ainsi de suite
Merci bcp

 

[Robert]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

Bonsoir AKSooL, bonsoir le forum,

Si j'ai bien compris... Essaie comme ça :

Private Sub Save_Click() 'au clic sur "Enregistrer données"
'si "Oui" au message, les cellules seront enregistrées
 
Dim dest As Range 'déclare la variable dest (DESTination)
Dim p As Range 'déclare la variable p (Plage)
Dim cel As Range 'déclare la variable cel (CELulle)
Dim x As Byte 'déclare la variable x
 
'définit la variable p
Set p = Sheets("Datacollection").Range("D12,C5:C6,E5,B10:B13,E16:E23,B26:B37,D39:D40,C42,C43,E42,B48:B59,E65:E73,B78:B87,C78:C87,E78:E87,B92:B102,C92:C102,E92:E102,E105:E109")
 
'définit la variable dest
With Sheets("Archive")
    If .Range("B1").Value = "" Then 'condition : si B1 est vide
        Set dest = .Range("B1") 'dest = B1
    Else 'sinon
        Set dest = .Range("B65536").End(xlUp).Offset(1, 0) 'dest = la première cellule vide rencontrée en colonne B
    End If 'fin de la condition
End With
 
For Each cel In p 'boucle sur toutes les cellule de la plage p
    cel.Copy dest.Offset(0, x) 'copy et colle la cellule
    x = x + 1 'définit la variable x
Next cel 'prochaine cellule de la plage p
 
p.ClearContents 'efface le contenu de la plage p
End Sub

 

[AKSooL]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

Je viens d essayer , effectivement il est en Ligne et incremente
mais par contre , si j ai des formules dans ces cellules, il me les enleves toutes , donc en gros je veux juste les valeurs des cellules .
Dois je modifier qq chose
Merci

 

[Compte Supprimé 979]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

B'soir

Je m'incline devans le savoir de Robert

Sauf que pour un débutant, bonjour le code ....
Va falloir trimer dur pour comprendre

 

[Excel_lent]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

Bonsoir à tous et aux autres.

C'est fait* donc autant l'envoyer.

* moins développée que la proposition de Robert.

 

[AKSooL]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

Merci encore , quel communauté superbe
Mais en esperant ne pas te vexer , le resultat de robert et meilleur, c est en ligne et cela s incremente

 

[Excel_lent]

Re : Help Me - VBA excel , tout simple mais j y arrive pas

Re,

Il ne manquerait plus que cela !

Si tu veux l'avoir en ligne, remplace dans mon code :
.Offset(li, 0) par .Offset(0, li).
Pour incrémenter, comme tu dis, il suffirait de jouer sur le 0 de l'offset.