XL pour MAC répéter la même action sur plusieurs lignes

clineM

XLDnaute Junior
Bonjour, je dois traiter des données assez rapidement et je n'y connais absolument rien en codage.
Sur la première feuille je dois copier plusieurs lignes (7 lignes sur 4 colonnes) puis les coller dans une seconde feuille en transposé puis déplacer les 3 lignes du dessous pour les aligner à la première ligne.
Et je veux répéter cette action en prenant les 7 prochaines lignes de la 1ière feuille !
voilà ce que j'obtiens en enregistrant mes actions :
Sub Nb_CPS_Replicats()
'
' Nb_CPS_Replicats Macro
'

'
Range("E5:H11").Select
Selection.Copy
Sheets("Feuil1").Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("D4:J6").Select
Application.CutCopyMode = False
Selection.Cut Destination:=Range("K3:Q5")
Range("K4:Q5").Select
Selection.Cut Destination:=Range("R3:X4")
Range("R4:X4").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
Selection.Cut Destination:=Range("Y3:AE3")
Range("Y3:AE3").Select
Sheets("Exported Labbook").Select
Range("E23:H29").Select
Selection.Copy
Sheets("Feuil1").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("D5:J7").Select
Application.CutCopyMode = False
Selection.Cut Destination:=Range("K4:Q6")
Range("K5:Q6").Select
Selection.Cut Destination:=Range("R4:X5")
Range("R5:X5").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Selection.Cut Destination:=Range("Y4:AE4")
Range("Y4:AE4").Select
End Sub

Y aurait-il quelqu'un pour m'aider à automatiser cette action ?
Merci
 

Pièces jointes

  • Test-Nov-MSE.xlsm
    73.9 KB · Affichages: 8

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @clineM,

Par contre je n'arrive pas à ouvrir le document les macros sont supprimées !

Etrange...

Voici le code que j'ai écrit et que vous pouvez copier dans votre propre classeur:
VB:
Option Explicit

Sub Nb_CPS_Replicats()
Dim t, i&, j&, k&, m&, lig&, col&

With Sheets("Feuil1")
   .Range(Range("c3"), .Cells(Rows.Count, Columns.Count)).ClearContents
End With
With Sheets("Exported Labbook")
   If .FilterMode Then .ShowAllData
   t = .Range("a2").CurrentRegion
End With

ReDim r(1 To 1000, 1 To 29)
For i = 1 To UBound(t)
   If t(i, 2) = "Intensity per Run" Then
      col = 1: lig = lig + 1
      r(lig, col) = t(i, 3)
      For k = 5 To 8
         For m = i To (i + 6)
            col = col + 1
            r(lig, col) = t(m, k)
         Next m
      Next k
      i = i + 6
   End If
Next i
Sheets("Feuil1").Range("c3").Resize(lig, 29) = r
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @clineM
maintenant me reste plus qu'a déchiffrer le code pour savoir le reproduire !

Voir ci-dessous le code commenté:
VB:
Option Explicit

Sub Nb_CPS_Replicats()
Dim t, i&, j&, k&, m&, lig&, col&

With Sheets("Feuil1")
   ' on commence par effacer les anciens résultats. On efface  depuis la cellule C3
   ' jusqu'à la dernière cellule de la feuille (qui a pour ligne le nombre de lignes de la feuille
   ' et pour colonne le nombre de colonnes de la feuille)
   .Range(Range("c3"), .Cells(Rows.Count, Columns.Count)).ClearContents
End With
With Sheets("Exported Labbook")
   ' on transfère les données source dans un tableau en mémoire nommé t
   ' juste avant, on affiche toutes les données au cas où il y aurait un filtre en cours
   If .FilterMode Then .ShowAllData
   ' transfert des données dans le tableau t
   ' .Range("a2").CurrentRegion est l'équivalent au clavier de: Se placer sur A2 puis tapez
   ' la combinaisons des deux touches Ctrl + * (Contrôle et étoile)
   t = .Range("a2").CurrentRegion
End With

' r va être le tableau en mémoire qui va contenir le résultat
' r est dimensionné à 1000 lignes (on suppose qu'on aura au max 1000 lignes de résultat)
' r est dimensionné à 29 colonnes (1 colonne pour le "sample name" suivie de 28 colonnes
'   pour les quatre "Replicate Data" [4 fois 7 valeurs] )
ReDim r(1 To 1000, 1 To 29)      'déclaration du tableau des résultats

' boucle de remplissage de r à partir du tableau des données source t
' tout va se passer en mémoire - pas d'interaction avec les feuilles Excel
' les traitements sont donc très rapides

For i = 1 To UBound(t)      ' on boucle sur les lignes du tableau source t
                            ' ubound(t) est l'index de la dernière ligne du tableau t
   If t(i, 2) = "Intensity per Run" Then
      ' on a trouvé en première colonne la valeur "Intensity per Run"
      ' i est donc le début d'une ligne  à traiter (en fait, on va traiter les 7 lignes (à partir de i))
      ' on définit la colonne nouvelle du résultat dans le tableau r (on recommence à la colonne 1 car nouvelle ligne)
      ' on définit la ligne nouvelle du résultat  dans le tableau r (on descend d'une ligne dans r)
      col = 1: lig = lig + 1
      'on inscrit le nouveau "Sample Name" qui est l'élément du tableau t en ligne i et en colonne 3
      r(lig, col) = t(i, 3)
      ' maintenant on va parcourir les 4 colonnes de la colonne 5 à la colonne 8
      '     c'est à dire les colonnes correspondant aux quatre "(M-SQ-N/A)" qui nous intéressent
      For k = 5 To 8
      ' pour chacune des colonne k, on va parcourir pour les 7 lignes à partir de la ligne i.
      ' On va y trouver les 7 valeurs en colonne qu'on va reporter (en ligne) dans le tableau résultat r
         For m = i To (i + 6)    ' parcours des 7 lignes de la colonne k
            col = col + 1        ' on écrit sur une colonne de plus à gauche dans le tableau résultat
            r(lig, col) = t(m, k)   ' on y met la valeur correspondant à la ligne m et colonne k
         Next m   ' ligne suivante de t
      Next k   ' colonne suivante de t  'une fois parcouru les 7 lignes, on va passer à la colonne suivante
      ' on a fini de traiter nos 4 colonnes:
      ' dans notre traitement, on a parcouru les lignes de i à i+6, mais la valeur de i n'a pas été modifié.
      ' on veut continuer à examiner les lignes juste après le paquet de 7 lignes qu'on vient de traiter
      ' il faut donc incrémenter i de 6 unités (sinon on traiterait des lignes déjà traitées)
      i = i + 6
   End If
Next i
' r a été rempli  | le nombre de ligne utile est dans la variable: Lig
'                 | le nombre de colonne utile est 29
'                 | on inscrit la partie utile du tableau r à partir
'                   de la cellule C3 de la feuille "Feuil1"
Sheets("Feuil1").Range("c3").Resize(lig, 29) = r
End Sub
 
Dernière édition:

Frankette

XLDnaute Nouveau
Bonjour à tous,

J'ai sensiblement la même question, dans la feuille nommée feuil5, se trouve des données organisées en ligne. Le but étant de les transférer sur une autre feuille afin de respecter le format comptable (voir feuille final). Ainsi, une ligne de la feuil5 se divise en 3 lignes (HT, TVA, TTC pour faire simple). Pour le coup, le HT se trouve toujours dans la colonne crédit ainsi que la TVA. Le TTC va en colonne débit. Ensuite il faut répéter l'action sur la ligne suivante jusqu'à la fin du tableau (plusieurs centaines de lignes).

Ci-dessous se trouve l'enregistrement des actions :
Sub Macro1()
'
' Macro1 Macro
' Mise en forme KOALA
'

'
ActiveCell.FormulaR1C1 = "=Feuil5!RC[2]"
Range("B2").Select
ActiveCell.FormulaR1C1 = "VT"
Range("C2").Select
ActiveCell.FormulaR1C1 = "706000"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=Feuil5!RC[-2]"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=Feuil5!RC[-4]"
Range("F2").Select
Application.CutCopyMode = False
Range("G2").Select
ActiveCell.FormulaR1C1 = "=Feuil5!RC[-3]"
Range("A3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("B3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("C3").Select
ActiveCell.FormulaR1C1 = "445700"
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("E3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=Feuil5!R[-1]C[-2]"
Range("A4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("B4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=Feuil5!R[-2]C[-2]"
Range("D4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("E4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("F4").Select
ActiveCell.FormulaR1C1 = "=Feuil5!R[-2]C"
Range("A5").Select
End Sub

J'espère que vous pourrez m'aider. Par avance, merci !
 

Pièces jointes

  • Modèle mise en forme KOALA.xlsx
    12.1 KB · Affichages: 5

Discussions similaires

Réponses
4
Affichages
555