Discussion :

[natalolo]

bonjour à tous
je souhaite copier différentes cellules ( cellules non adjacentes)de ma feuille 1. Par exemple cellule A2, B2, D3, F4, H8 et les coller sur ma feuille 2 en A2, B2, C2 ,D2, E2

Quand j'active ma macro je souhaite, a chaque nouvelle saisie de mes données de la feuille 1 copier les mêmes cellules de ma feuille 1 sur les mêmes colonnes de ma feuille 2 mais une ligne en dessous, c'est à dire A2, B2, C2 , D2,E2
et ainsi de suite à chaque fois que j'active ma macro copier une ligne en dessous.

A chaque saisie une nouvelle ligne est donc créée soit automatiquement (sans bouton macro) ou alors avec bouton.

Je commence tout juste à m'initier au VBA et je pense que l'un d'entre vous pourrait m'épauler. Si besoin je peux vous envoyer le fichier de travail

Merci pour votre aide.....précieuse

[had4789]

Bonjour,

Regarde ça,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Sub Macro9()
 
    Range("A2,B2,D2,F2,H2").Select
    Selection.Copy
    Sheets("Feuil1").Select
    ActiveSheet.Paste
 
End Sub

[Invité]

Salut,

Pas très efficace, mais à essayer tout de même:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub CopyRange1()
 
    Dim Area As Range
    Dim n As Long
 
    For Each Area In ThisWorkbook.Worksheets("Feuil1").Range("A2, B2, D3, F4, H8").Areas
        n = n + 1
        ThisWorkbook.Worksheets("Feuil2").Range("A2").Offset(, n - 1) = Area.Cells(1, 1).Value
    Next
 
End Sub

Le Cells(1,1) est là pour s'assurer qu'il n'y a bien qu'une seule cellule pour ne copier que la 1ère cellule d'une Area.

[natalolo]

Bonjour,

Merci pour vos retours la première solution apportée ne me permet que de copier les données et ne permet pas à la seconde saisie de la totalité des données d'être copié sur la 2ème ligne vide de mon fichier. Merci néanmoins pour ce retour rapide.
La 2ème solution testée ne m'a pas apporté de résultat : j'ai essayé de me l'approprier selon le fichier que j'ai construit, voilà ce que cela donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro1()
'
' Macro1 Macro
'
 
    Dim Area As Range
    Dim n As Long
 
    For Each Area In ThisWorkbook.Worksheets("Fiche de saisie").Range("A2, B2, D3, F4, H8").Areas
        n = n + 1
        ThisWorkbook.Worksheets("saisie enregistrée").Range("A2").Offset(, n - 1) = Area.Cells(1, 1).Value
    Next
 
End Sub

Je suis un peu perdu car je pensais qu'il fallait introduire la nécessité d'aller rechercher la première ligne vide du fichier où la totalité de mes données seront sauvegardées (fichier : "saisie enregistrée).
En effet, à chaque saisie de ces 5 cellules, le fichier "saisie enregistrée" doit enregistrer sur une seule ligne ces données et ainsi de suite sur la 2ème ligne pour la nouvelle saisie de ces 5 données.
Je ne sais pas si je suis trés clair : je peux vous joindre mon fichier de travail si vous le souhaitez.
Dans tous les cas un grand merci pour vos retours....je continue à tester ......!!!
.......

Après de nouvelles recherches: j'ai trouvé ceci : mais bémol les données ne sont pas copiées sur une seule ligne or je souhaite que tous les enregistrement tiennent sur une seule ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Macro1()
'
' Macro1 Macro
'
ActiveSheet.UsedRange.Select
Selection.Copy
    Sheets("saisie enregistrée").Select
Range("A" & Cells(Rows.Count, "a").End(xlUp).Row + 12).PasteSpecial xlPasteValues
End Sub

[Invité]

Effectivement, c'est bizarre.

Avant execution de la Macro, dans une feuille appelé "Fiche de saisie", j'obtiens:

La feuille "saisie enregistrée" est totalement vide avant éxecution.


Dans la feuille "saisie enregistrée", Après execution:



Nouveau code plus générique (presque identique):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub CopyCellsToColumns(Source As Range, Destination As Range)
 
    Dim Area As Range
    Dim i As Long
    Dim ParamCalc As VBACALCULPERFORMANCETYPE
 
On Error GoTo Finish
 
    BeforeVBACalculate ParamCalc
 
    For Each Area In Source.Areas
        i = i + 1
        Destination.Cells(1, 1).Offset(, i - 1).Value = Area.Cells(1, 1).Value
    Next
 
Finish:
    AfterVBACalculate ParamCalc
 
End Sub

A mettre dans un module standard:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Option Explicit
Option Private Module
 
Public Type VBACALCULPERFORMANCETYPE
    ScreenUpdating As Boolean
    Calculation As XlCalculation
    EnableEvents As Boolean
    DisplayStatusBar As Boolean
End Type
 
Function BeforeVBACalculate(UserDefinedType As VBACALCULPERFORMANCETYPE)
    With Application
        UserDefinedType.ScreenUpdating = .ScreenUpdating
        UserDefinedType.Calculation = .Calculation
        UserDefinedType.EnableEvents = .EnableEvents
        UserDefinedType.DisplayStatusBar = .DisplayStatusBar
 
        .ScreenUpdating = False
        .Calculation = XlCalculation.xlCalculationManual
        .EnableEvents = False
        .DisplayStatusBar = False
    End With
End Function
Function AfterVBACalculate(UserDefinedType As VBACALCULPERFORMANCETYPE) As Boolean
    With Application
        .ScreenUpdating = UserDefinedType.ScreenUpdating
        .Calculation = UserDefinedType.Calculation
        .EnableEvents = UserDefinedType.EnableEvents
        .DisplayStatusBar = UserDefinedType.DisplayStatusBar
    End With
End Function

Test:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Sub CopyCellsToColumnsTest()
    CopyCellsToColumns Source:=ThisWorkbook.Worksheets("Fiche de saisie").Range("A2, B2, D3, F4, H8"), _
                       Destination:=ThisWorkbook.Worksheets("saisie enregistrée").Range("A2")
End Sub

--------------------------------------------------------------------------------------------------------------

A voir si il y a du changement avec cette Macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub CopyCellsToColumns2(Source As Range, Destination As Range)
 
    Dim Area As Range
    Dim j As Long
    Dim ParamCalc As VBACALCULPERFORMANCETYPE
    Dim aAreaValue
 
On Error GoTo Finish
 
    BeforeVBACalculate ParamCalc
 
    ReDim aAreaValue(1 To 1, 1 To Source.Areas.Count)
    For j = LBound(aAreaValue, 2) To UBound(aAreaValue, 2)
        aAreaValue(1, j) = Source.Areas(j).Cells(1, 1).Value
    Next
    Destination.Cells(1, 1).Resize(1, UBound(aAreaValue, 2)).Value = aAreaValue
 
Finish:
    AfterVBACalculate ParamCalc
 
End Sub

Test:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Sub CopyCellsToColumnsTest2()
    CopyCellsToColumns2 Source:=ThisWorkbook.Worksheets("Fiche de saisie").Range("A2, B2, D3, F4, H8"), _
                        Destination:=ThisWorkbook.Worksheets("saisie enregistrée").Range("A2")
End Sub

-----------------------------------------------------------------------------------

Plutôt:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub CopyCellsToColumns3(Source As Range, Destination As Range)
 
    Dim Area As Range
    Dim j As Long
    Dim ParamCalc As VBACALCULPERFORMANCETYPE
    Dim aAreaValue
 
    BeforeVBACalculate ParamCalc
 
On Error GoTo Finish
 
    ReDim aAreaValue(1 To 1, 1 To Source.Areas.Count)
    For j = LBound(aAreaValue, 2) To UBound(aAreaValue, 2)
        aAreaValue(1, j) = Source.Areas(j).Cells(1, 1).Value
    Next
    Destination.Cells(1, 1).Resize(1, UBound(aAreaValue, 2)).Value = aAreaValue
 
Finish:
    AfterVBACalculate ParamCalc
    With Err
        If CBool(.Number) Then MsgBox "Erreur : " & .Number & vbCrLf & .Description
    End With
End Sub

[natalolo]

Encore félicitation pour tous ces essais...mais cela ne fonctionne pas : peut-être que je ne m'y prend pas correctement ???
Aussi je décide de vous livrer mon fichier (l'onglet"fiche de saisie" doit se déverser sur une seule ligne sur l'onglet"saisie enregistrée" . (la feuille 1 est ce que souhaite obtenir à chaque saisie des 16 données (en fait j'ai beaucoup plus de données qu'annoncées.....!!!!)

Je suis perplexe mais ne désespère pas de trouver la solution;
Merci pour vos réflexions

[patricktoulon]

Bonjour
rien de bien compliqué j'ai commenté le code pour une meilleur comprehention

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub tranfert_saisie()
Dim tablo As Variant, derlig As Long
'array representant le nom des cellule de la fiche de saisie dans l'ordre dans le quel elles seront transposées
plage = Array("A2", "b2", "d3", "f4", "h8", "d8", "j4", "j8", "l4", "b8", "f10", "d11", "f13", "h3", "i11", "b11")
ReDim tablo(1, UBound(plage)) ' redimentionnement d'une varaible de type tableau avec le nombre d'element dans l'array
For i = 0 To UBound(plage)
'inscription des données des cellules dans chaque items da la variable tableau
tablo(0, i) = Sheets("Fiche de saisie").Range(plage(i))
Next
'recupération de la premiere ligne vide et libre de la feuille de destination
derlig = Sheets("Saisie enregistrée").Range("A" & Rows.Count).End(xlUp).Row + 1
'resize de la cellule A et derlig a la dimention du tableau et pose de du tablo
Range("A" & derlig).Resize(1, UBound(plage)) = tablo
End Sub

Au plaisir

[natalolo]

Je crois que nous avançons mais après avoir intégré cette macro, la copie s'effectue sur l'onglet "fiche de saisie" et non pas sur l'onglet "saisie enregistrée" et je ne sais pas si en exécutant la macro les nouvelle données se positionnent sur la ligne suivante vierge.......

j'ai pourtant saisie les même données préconisées ??? je pense que nous ne sommes pas loin d'aboutir !!!
Merci pour toutes ces précisions en attendant de toucher au but.

Je joints le fichier qui intègre la macro.

[natalolo]

Errare humanum est, perseverare diabolicum
j'ai compris mon erreur : le bouton de ma macro est positionné dans l'onglet "fiche de saisie" et non pas "saisie enregistrée", quand je place le bouton associé à la macro dans le bon onglet) tout fonctionne à la perfection.

Pour aller plus loin : est-il possible d'intégrer le bouton dans la fiche de saisie et que cela fonctionne ?
et est-il possible d'intégrer cette macro sans utiliser de bouton de lancement de macro associé avec enregistrement automatique du fichier....????

Merci pour la réactivité et les explications

[patricktoulon]

Re
met ma macro dans un module standard

met ton bouton dans le sheets que tu veux
et dans le click du bouton
le nom de la macro un point c'est tout c'est pas compliqué

[natalolo]

OUF; c'est vrai que je me perds facilement et balbutie.....
un grand merci : tout fonctionne à merveille et ce n'est que du bonheur.
Bonne fin de soirée, j'essaye de ne pas trop abuser...en tout cas : EXTRA

[Invité]

Salut tout le monde,

Pour aller plus loin : est-il possible d'intégrer le bouton dans la fiche de saisie et que cela fonctionne ?
et est-il possible d'intégrer cette macro sans utiliser de bouton de lancement de macro associé avec enregistrement automatique du fichier....????

Tu peux exécuter le code en l'appelant depuis un événement qui est appelé a chaque fois que tu enregistre ton classeur. C'était ça la question ?

Si tu prends le code de mister Toulon, dans le module ThisWorkbook, mettre ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    tranfert_saisie
End Sub

Le code s'exécutera tout seul à chaque sauvegarde du fichier.