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