Macro Excel Déplacer Cellule+Insertion

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Je trouve toujours réponse a mes questions en consultant les sujets existants, sauf quand ca touche aux macros, ou la solution n'est pas toujours à portée de clic :mouarf:
Fichier excel en exemple. J'ai trouvé une macro qui déplace des cellules, mais je n'en comprends pas son fonctionnement et du fait, je ne sais pas exactement de quelle façon me l'approprier.
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 Sub TEST() ' Range("A3917").Activate ActiveCell.CurrentRegion.Select 'MsgBox ActiveCell.CurrentRegion.Rows.Count nombrel = ActiveCell.CurrentRegion.Rows.Count / 2 Range("A3918").Select For i = 1 To nombrel Selection.EntireRow.Insert Selection.Offset(1, 0).Select Next i End Sub Sub Macro4() ' ' Macro4 Macro ' ' Range("A8").Activate Range("A8:I8").Select Selection.Delete shift:=xlToLeft End Sub Sub Decalage() Dim Lg As Long Dim J As Long Application.ScreenUpdating = False For J = 30 To Range("J65536").End(xlUp).Row Step 2 If Application.CountA(Range("A" & J).Resize(1, 9)) = 0 Then Range("A" & J).Resize(1, 9).Delete shift:=xlShiftToLeft End If Next J End Sub
Je ne sais pas si tout est à reprendre ou s'il faut créer quelque chose de nouveau.

L'idée, avec le bouton Macro, déplacer des cellules inscrites manuellement en colonne B et D(celles inscrites dans le cadre en tirets, ici créé pour l'exemple mais sera absent de mon fichier final).
L'un des 3 codes plus bas (1, 2 ou 3) est aussi inséré manuellement dans le cadre jaune.

J'aimerais donc les coller en insérant de nouvelles lignes dans l'onglet Source, idéalement dans les premieres lignes pour chaque code client.

De plus, j'ai une macro sur un autre fichier qui enregistre une copie de la feuille actuelle, est il possible par la même occasion et donc le même bouton, enregistrer la feuille active sur un nouveau fichier ? (Juste avant d'avoir déplacé les cellules par exemple)
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 Sub saveAndQuit() On Error Resume Next Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:\Users\lereuland\Desktop\" _ & Range("C9").Value & ".xlsm" 'ThisWorkbook.Close Application.DisplayAlerts = True End Sub Sub Archiver() Dim extension As String Dim chemin As String, nomfichier As String Dim style As Integer Application.ScreenUpdating = False ThisWorkbook.ActiveSheet.Copy extension = ".xls" chemin = "C:\Users\lereuland\Desktop\" nomfichier = ActiveSheet.Range("C9") & " " & Format(Date, "dd-mm") & extension With ActiveWorkbook .ActiveSheet.DrawingObjects(1).Delete .SaveAs chemin & nomfichier, xlExcel8 .ActiveSheet.UsedRange.Value = .ActiveSheet.UsedRange.Value .Close True End With Application.ScreenUpdating = True End Sub
Lors de l'enregistrement j'ai quelques messages d'erreur de compatibilité, je vous posterai les screens si je les ai toujours avec ce nouveau fichier si vous voulez bien :P

J'espère avoir bien expliqué ma demande, n'hésitez pas à me demander des précisions supplémentaires au besoin. Merci beaucoup à vous !

Bonjour,

commentaires dans le code :

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
 
Sub TEST()
 
    Dim I As Long
 
    'insère un nombre de lignes égal à la moitié de la zone située autour de A3917
    For I = 1 To Range("A3917").CurrentRegion.Rows.Count / 2
        Range("A" & 3917 + I).EntireRow.Insert
    Next I
 
End Sub
 
Sub Decalage()
 
    Dim Lg As Long
    Dim J As Long
 
    Application.ScreenUpdating = False
 
    'boucle une ligne sur deux (--> Step 2)
    For J = 30 To Range("J65536").End(xlUp).Row Step 2
 
        'si dans la plage de A à I (9 colonnes) sur la ligne en cours aucune cellule ne
        'contient une valeur, supprime la ligne
        If Application.CountA(Range("A" & J).Resize(1, 9)) = 0 Then
            Range("A" & J).Resize(1, 9).Delete shift:=xlShiftToLeft
        End If
 
    Next J
 
End Sub

Pour enregistrer une copie de la feuille active c'est :

Code:

1
2
 
ActiveSheet.Copy

Le fait de ne pas préciser de destination derrière Copy engendre la création d'un nouveau classeur !

24/04/2016, 19h37
lereuland

1 pièce(s) jointe(s)

Re,

Merci pour votre message. Pour l'enregistrement, on verra ca plus tard mais ca a l'air de fonctionner en effet. Il a l'air de convertir tout seul les formules en valeur finale donc c'est tres bien.

J'aimerais surtout arriver à faire fonctionner les 2 autres macros (insertion lignes & couper/coller des cellules du premier onglet sur le 2è). Je suis parvenu a faire insérer 1 ligne dans l'onglet de la macro, mais dès que je change la valeur de I ca ne fonctionne plus. De plus, les lignes à insérer auraient du être insérées sur le 2è onglet, et je ne sais pas comment lui spécifier le nom du 2è onglet? J'ai essayé avec un "!" mais ca n'a pas fonctionné.
Je ne souhaite pas supprimer les lignes mais juste déplacer la cellule au travers d'un couper/coller. Les lignes du premier onglet ne doivent pas être modifiées.
Dans l'exemple ici sur lequel on pourrait travailler, il faudrait que les cellules de Base! de B5 à B11 et D5 à D11 qui contiennent une donnée soient collées sur l'onglet source, à partir de la cellule B14 (qui ajoute donc le Code Clt 3 automatiquement (ou repris en cellule C2 de l'onglet base), puis en cellule C & D 14 on aurait de B5 à D11 en gros.

Merci pour votre retour !

1 pièce(s) jointe(s)

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
Sub Insert()
 
    Dim I As Long
 
    'insère un nombre de lignes égal à la moitié de la zone située autour de A3917
    For I = 1 To Range(B5).CurrentRegion.Rows.Count
        Range("C" & 5 + I).EntireRow.Insert
    Next I
 
End Sub
 
Sub Decalage()
 
   Dim J As Long
 
    'ca de ce que j'ai compris, ca empeche le rafraichissement des cellules avant execution et fait gagner du temps dans l execution de la macro
        Application.ScreenUpdating = False
 
 
    'boucle une ligne sur deux (--> Step 2) la si je remplace 2 par 1, il execute une boucle ligne après ligne, vrai?
    'donc la pour moi, il part de B11 et remonte vers le haut (B5)
    For J = 5 To Range("B11").End(xlUp).Row Step 1
 
        'si dans la plage de B à D (3 colonnes) sur la ligne en cours aucune cellule ne
        'contient une valeur, supprime la ligne
        'CountA ca fait quoi? C'est juste un nom donné pour stocker le nombre de cellules?
            If Application.CountA(Range("B" & J).Resize(1, 3)) = 0 Then
            Range("B" & D).Resize(1, 9).Delete shift:=xlShiftToRight
        End If
 
    Next J
 
End Sub

Re
Je me suis permis de remettre quelques commentaires la ou je ne comprends pas vraiment. J'essaie deja de lui faire selectionner les cellules entre colonnes B et D et les déplacer vers la droite par exemple, ca serait déjà un bon pas :D

Une fois que j'aurai compris comment déplacer vers le haut bas gauche ou droite, il me restera à trouver comment déplacer les cellules sur un autre onglet, et enfin comment insérer de nouvelles lignes à un endroit précis pour coller les cellules des colonnes B à D :D