Boucle pour simplifier mon code: comment faire ?

[LPandre]

Sur un autre post, je proposais de copier autant de fois que nécessaire ( en fonction du nombre de colonnes) un code donné.
Simplement par ce que je ne sais pas faire de boucle.
Comment remplacer le code ci dessous pour avoir une boite de dialogue qui demande "Première colonne ?" et je réponds F
Dernière colonne ? et je réponds H ( ou bien combien de colonnes avec F ? et je réponds 3)
et le code fait 3 fois la boucle des colonnes F à H
Ensuite, le code de copie des Dim et NBVAL , fait aussi 3 fois la boucle depuis la colonne A ( c'est toujours la A sur ma feuille réca 2)
Par avance merci.

***********
' copie des données de la feuille réca et suppression des cellules vides dans réca 2
Sheets("Réca").Select
Columns("F:F").Select
Selection.Copy
Sheets("Réca (2)").Select
Range("A1").Select
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Sheets("Réca").Select
Columns("G:G").Select
Selection.Copy
Sheets("Réca (2)").Select
Range("B1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Sheets("Réca").Select
Columns("H:H").Select
Selection.Copy
Sheets("Réca (2)").Select
Range("C1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp



' copie de la formule pour connaitre le nombre de valeurs de chaque colonne

Dim A As Long
A = Range("A65536").End(xlUp).Row
Range("A" & A + 1).Select
ActiveCell.FormulaLocal = "=NBVAL(A2:A" & A & ")"
Dim B As Long
B = Range("B65536").End(xlUp).Row
Range("B" & B + 1).Select
ActiveCell.FormulaLocal = "=NBVAL(B2:B" & B & ")"
Dim C As Long
C = Range("C65536").End(xlUp).Row
Range("C" & C + 1).Select
ActiveCell.FormulaLocal = "=NBVAL(C2:C" & C & ")"

**********

 

[skoobi]

Re : Boucle pour simplifier mon code: comment faire ?

Bonjour,

voici une proposition, sans les Select, inutile (comme souvent):

Sub test()
Dim Lig As Long, Nbre As String
Nbre = InputBox("Combien de colonne?")
If Nbre <> "" Then
For i = 6 To 6 + Nbre - 1
With Sheets("Réca (2)")
  Sheets("Réca").Columns(i).Copy .Columns(i - 5)
  .Columns(i - 5).SpecialCells(xlCellTypeBlanks).Delete
  Lig = .Cells(65536, i - 5).End(xlUp).Row
  .Cells(Lig + 1, i - 5).FormulaLocal = "=NBVAL(" & .Cells(1, i - 5).Address(0, 0) & ":" & .Cells(Lig, i - 5).Address(0, 0) & ")"
End With
Next
End If
End Sub

Edit: ajout du nombre de valeurs de chaque colonne

 

[LPandre]

Re : Boucle pour simplifier mon code: comment faire ?

Re : salut Skoobi et merci.

ça ne fonctionne pas comme je le souhaiterais.
je joins un fichier avec ma macro qui va bien mais qui est lourde de code et peu adaptative, et ta macro également dans le même module.


J'ai laissé à l'écran le résultat souhaité, mais tu n'as pas besoin de moi pour lancer une macro 🙂

De nouveau merci.

 

[LPandre]

Re : Boucle pour simplifier mon code: comment faire ?

Bon j'ai bricolé un peu le code de Skoobi, mais j'ai obtenue ce que je voulais :

40 lignes au lieu de 240 et macro adaptative.

@+

 

[skoobi]

Re : Boucle pour simplifier mon code: comment faire ?

Re,

Voici les modifications (en bleu):

Sub test()
Dim Lig As Long, Nbre As String
' Nettoyage feuille réca 2
 
[B][COLOR=blue]Sheets("Réca (2)").Cells.Clear[/COLOR][/B]
    ' Boucle Skoobi :
 
Nbre = InputBox("Combien de colonne?")
If Nbre <> "" Then
For I = 6 To 6 + Nbre - 1
With Sheets("Réca (2)")
  Sheets("Réca").Columns(I).Copy .Columns(I - 5)
  .Columns(I - 5).SpecialCells(xlCellTypeBlanks).Delete [COLOR=blue][B]shift:=xlUp[/B][/COLOR]
  Lig = .Cells(65536, I - 5).End(xlUp).Row
  .Cells(Lig + 1, I - 5).FormulaLocal = "=NBVAL(" & .Cells(2, I - 5).Address(0, 0) & ":" & .Cells(Lig, I - 5).Address(0, 0) & ")"
End With
Next
End If
Range("A2").Select
End Sub

Edit: Ceci ne tient pas compte de ton mail de 15h11.

 

[LPandre]

Re : Boucle pour simplifier mon code: comment faire ?

Re :
Impec Skoobi ! J'ai viré mon code et copié /collé le tien, encore quelques lignes de gagnées.

@+