macro copier/coller valeurs

Version imprimable

08/10/2020, 23h24
AlexFEBo

1 pièce(s) jointe(s)

macro copier/coller valeurs

Bonjour,

Je suis en train d'essayer de créer une macro sur Excel mais je bloque sur un procéder de copier/coller des valeurs:
- Je ne désire pas toucher ma colonne A
- Pour les colonnes suivantes j'ai toujours le même format: Colonne B = valeurs brutes, Colonne C = formule avec les valeurs de la colonne B / Colonne D = valeurs brutes, Colonne E = formule avec les valeurs de la colonne D et ainsi de suite.

Je désire ne garder que les valeurs des colonnes C,E, et ainsi de suite.

J'ai essayé d'utiliser la fonction d'enregistrement et de bidouiller un peu mais je ne m'en sort pas vraiment...

Idéalement je voudrais obtenir ma première colonne intacte suivie de toutes mes colonnes contenant uniquement les valeurs calculées.

J'ai attaché un fichier "démo" avec les colonnes que je veux garder en grisé...

Si quelqu'un peut m'aider ce serait super! Un grand merci d'avance!

Alex

Bonjour,

Comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Copier_Zone_Calculee()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    DerLig = f1.Range("A" & Rows.Count).End(xlUp).Row
    f2.Range("A1:A" & DerLig).Value = f1.Range("A1:A" & DerLig).Value
    f2.Range("B1:B" & DerLig).Value = f1.Range("C1:C" & DerLig).Value
    f2.Range("C1:C" & DerLig).Value = f1.Range("E1:E" & DerLig).Value
    f2.Range("D1:D" & DerLig).Value = f1.Range("G1:G" & DerLig).Value
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

09/10/2020, 09h29
AlexFEBo

Génial merci beaucoup!

Petite demande supplémentaire:
Le nombre de colonnes n'est pas toujours le même, j'aimerais idéalement que cette macro soit appliquée à ma feuille entière (= toutes les colonnes non vides sauf la première).

Dois-je essayer d'insérer une boucle pour faire cela?

Merci encore

bonjour
à tester sur une copie de ton fichier ...je suis qu'un autodidacte :aie::aie:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Copier_Zone_Calculee()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
     f2.Cells.ClearContents
    DerLig = f1.Range("A" & Rows.Count).End(xlUp).Row
    dercol = f1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    f1.Range(f1.Cells(1, 1), f1.Cells(DerLig, dercol)).Copy f2.Range("B1")
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

09/10/2020, 10h16
AlexFEBo

Merci,

C'est presque ça:

Je ne désire copier les valeurs que d'une colonne sur deux à partir de la colonne B (B,D,F,H...), la j'obtiens une copie des valeurs de toutes les colonnes :)

tester ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Copier_Zone_Calculee()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
     f2.Cells.ClearContents
 
    dercol = f1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    L = 1
    C = 2
    For X = 2 To dercol
    f1.Columns(X).Copy f2.Cells(1, C)
    L = L + 1
    C = C + 1
     X = X + 1
    Next X
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

09/10/2020, 10h42
AlexFEBo

Oups j'ai fait une erreur dans mon message précédent :/

Ce sont les valeurs en C, E, G etc... que je veux (j'avais écrit B, D, F... désolé).

J'ai également ma première colonne qui est vide avec ce code (la colonne A n'est pas copiée)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Copier_Zone_Calculee()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
     f2.Cells.ClearContents
 
    dercol = f1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    L = 1
    C = 2
    For X = 3 To dercol
    f1.Columns(X).Copy f2.Cells(1, C)
    L = L + 1
    C = C + 1
     X = X + 1
    Next X
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

ça pour copier C/E/G ... toujours en dépassant une colonne
je comprends pas l'histoire de la colonne A ??
si ti veux copier ces colonnes en colonne A de la feuille 2 :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Copier_Zone_Calculee()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
     f2.Cells.ClearContents
 
    dercol = f1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    L = 1
    C = 1
    For X = 3 To dercol
    f1.Columns(X).Copy f2.Cells(1, C)
    L = L + 1
    C = C + 1
     X = X + 1
    Next X
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

09/10/2020, 10h48
mfoxy

Bonjour Alex,

Ce qui est bien dans le Forum est d'expliquer correctement son besoin.
Perso, je viens de jeter un Œil et suis perdu dès ton deuxième Post ...

Nous sommes ici, pour donner des conseils spécifiques à une demande spécifique, ici l'ami BENNASR :salut:, viens certainement de perdre 3 fois le temps nécessaire à celui qui lui aurait fallu si tout aurait bien été expliqué dès le départ.

Tu lui devras un grand :merci: :lol:
09/10/2020, 10h51
AlexFEBo

Bonjour mfoxy,

J'ai essayé d'être le plus clair possible, mais en me relisant je voit que ce n'est pas le cas. J'aurais du me relire :/

BENNASR effectivement un grand merci pour votre aide!

Pour récapituler:
Je désire:
1- copier ma colonne A dans une nouvelle feuille (feuil2)
2- copier les valeurs des colonnes C, E, G et ainsi de suite jusqu'à la dernière colonne contenant des valeurs dans ma feuil2 juste après le colonne A (celle copiée dans 1-)

J'espère avoir été plus clair comme cela...
Avec le dernier code fournit, j'obtiens une copie "simple" c'est à dire les formules et pas les valeurs.

Merci encore

à tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Copier_Zone_Calculee()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
     f2.Cells.ClearContents
    dercol = f1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    L = 1
    C = 1
    For X = 1 To dercol
    f1.Columns(X).Copy
    f2.Cells(1, C).PasteSpecial Paste:=xlPasteValues
    L = L + 1
    C = C + 1
     X = X + 1
    Next X
    Application.CutCopyMode = False
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

09/10/2020, 11h45
AlexFEBo

C'est parfait!

Merci beaucoup!

Ps: Désolé pour ces étapes intermédiaires

Re,

J'ai eu un peu de temps à tué, donc juste pour l'exercice à ma façon :

1) on copie toute les cellules F1 vers F2;
2) on transforme le range F2 en valeur uniquement;
3) on boucle pour récupérer toute les colonne pair, pour en créer une liste;
4) on supprime toutes les colonnes en une fois;

Code:

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Sub TestbyMfoxy()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
 Dim f1 As Worksheet, f2 As Worksheet
 Dim LastCel As Range, columnsToDelete As Range
 
  With ThisWorkbook
   Set f1 = .Worksheets("Feuil1")
   Set f2 = .Worksheets("Feuil2")
   Set LastCel = getLastCellWithData(f1) 'On récupère la dernière ligne et col utilisé dans F1
  End With
 
    With f2
    .Cells.ClearContents 'Cleaning de l'extraction
    .Range(.Cells(1, 1), .Cells(LastCel.Row, LastCel.Column)).Value = f1.Range(f1.Cells(1, 1), f1.Cells(LastCel.Row, LastCel.Column)).Value 'Copier-coller de toute la plage f1 vers f2
    .Range(.Cells(1, 1), .Cells(LastCel.Row, LastCel.Column)).Value = .Range(.Cells(1, 1), .Cells(LastCel.Row, LastCel.Column)).Value 'On supprime toutes les Formules
     For i = LastCel.Column To 2 Step -1 'On boucle sur chaque colonne pour créér une liste des colonnes à supprimer (colonne pair)
      If (i Mod 2) = 0 And columnsToDelete Is Nothing Then Set columnsToDelete = .Columns(i)
      If (i Mod 2) = 0 And Not columnsToDelete Is Nothing Then Set columnsToDelete = Application.Union(columnsToDelete, .Columns(i))
     Next i
    End With
 
  If Not columnsToDelete Is Nothing Then columnsToDelete.Delete 'On Supprime Toutes les colonnes en une Fois
 
  Set LastCel = Nothing: Set columnsToDelete = Nothing 'Cleaning Variable
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
End Sub
 
 
Function getLastCellWithData(sh As Worksheet) As Range
 
'Pierre F sur DVP
  Dim r As Long: r = 1
  Dim c As Long: c = 1
  Dim EnableEvents As Boolean
  Dim cell As Range
 
 On Error GoTo EndHandler
  EnableEvents = Application.EnableEvents
  Application.EnableEvents = False
  If sh.Cells.SpecialCells(xlCellTypeLastCell).Address <> "$A$1" Then
    Set cell = sh.Cells.Find(what:="*", after:=sh.Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, _
      searchorder:=xlByRows, SearchDirection:=xlPrevious)
    If Not cell Is Nothing Then
      r = cell.Row
      c = sh.Cells.Find(what:="*", after:=sh.Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, _
        searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column
    End If
  End If
  Set getLastCellWithData = sh.Cells(r, c)
 
EndHandler:
  Application.EnableEvents = EnableEvents
End Function

12/10/2020, 17h44
AlexFEBo

Merci ça fonctionne aussi!:)

Je pourrais essayer de m'en servir de base pour faire autre chose!:)