Séparation HT

Bonjour à tous !

J'aimerai créer une macro à partir de ce fichier où pour toutes les feuilles de calculs sélectionnées avant d'utiliser la macro, elle extrait sur chaque ligne de la feuille le contenu de la colonne HT Goal avec des données entre parenthèse en 2 colonnes :

• En I : Utiliser la fonction STTXT(G3;2;1) jusqu'à la dernière ligne où il y a du contenu
• En H : Utiliser la fonction STTXT(G3;6;1) jusqu'à la dernière ligne où il y a du contenu

Nommer la cellule I2 : "A HT G"

Supprimer la colonne G

Je vous ai mis un exemple de résultat final dans le fichier joint sur la feuille 16-17.

Je vous remercie par avance pour votre aide et prenez soin de vous !

Laplacea

Re Adrien

Comme ceci ?

Sub cpt()
'déclaration feuille
Dim fsource As Worksheet
'declare variable de boucle
Dim i As Long
'declare variable pour derniere ligne Source
Dim derligdsource As Long
For Each fsource In ThisWorkbook.Sheets
    'initialise derniere ligne feuille source en cours
    derligdsource = fsource.Cells(Application.Rows.Count, "C").End(xlUp).Row
    fsource.Cells(2, 8).Value = "H HT G"
    fsource.Cells(2, 9).Value = "A HT G"
    For i = 3 To derligdsource
        fsource.Cells(i, 8).Value = Mid(fsource.Cells(i, 7).Value, 6, 1)
        fsource.Cells(i, 9).Value = Mid(fsource.Cells(i, 7).Value, 2, 1)
    Next i
    fsource.Select
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:J").Select
    Selection.Copy
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("I:J").Select
    Selection.Delete Shift:=xlToLeft
Next
End Sub

A plus sur le forum

Bonsoir laplacea, papyg, le forum,

pour toutes les feuilles de calculs sélectionnées avant d'utiliser la macro

Un essai....

• sélectionnes tes feuilles

• ctrl + e pour exécuter la macro...

Dans ton énoncé, tu dis:

- En I : Utiliser la fonction STTXT(G3;2;1) jusqu'à la dernière ligne où il y a du contenu

- En H : Utiliser la fonction STTXT(G3;6;1) jusqu'à la dernière ligne où il y a du contenu

Ne serai-ce pas l'inverse ?

Bonne soirée,

- En I : Utiliser la fonction STTXT(G3;2;1) jusqu'à la dernière ligne où il y a du contenu

- En H : Utiliser la fonction STTXT(G3;6;1) jusqu'à la dernière ligne où il y a du contenu

Capture.JPG

Ne serai-ce pas l'inverse ?

[/quote]

Effectivement c'est bien l'inverse, je viens de me rendre compte de mon erreur merci !

Peux tu m'envoyer le code ecris par message car je n'ai pas la macro quand j'ouvre le fichier.

papyg a écrit :

Sub cpt()
'déclaration feuille
Dim fsource As Worksheet
'declare variable de boucle
Dim i As Long
'declare variable pour derniere ligne Source
Dim derligdsource As Long
For Each fsource In ThisWorkbook.Sheets
    'initialise derniere ligne feuille source en cours
    derligdsource = fsource.Cells(Application.Rows.Count, "C").End(xlUp).Row
    fsource.Cells(2, 8).Value = "H HT G"
    fsource.Cells(2, 9).Value = "A HT G"
    For i = 3 To derligdsource
        fsource.Cells(i, 8).Value = Mid(fsource.Cells(i, 7).Value, 6, 1)
        fsource.Cells(i, 9).Value = Mid(fsource.Cells(i, 7).Value, 2, 1)
    Next i
    fsource.Select
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("I:J").Select
    Selection.Copy
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("I:J").Select
    Selection.Delete Shift:=xlToLeft
Next
End Sub

Le code marche bien quand je l'utilise sur les feuilles du fichier excel que j'utilise, mais ne marche pas lorsque je veux l'utiliser sur d'autres fichiers excels similaires. Il m'indique le code erreur suivant : "La méthode Select de l'objet Worksheet à échoué"

Je vous remercie pour votre aide ! C'est vraiment top !

Laplacea

Bonjour laplacea, papyg, le forum,

Peux tu m'envoyer le code ecris par message car je n'ai pas la macro quand j'ouvre le fichier.

Elle est pourtant dans le module 1,

Option Explicit

Public Sub Test(poOnglet As Worksheet)

 Dim derlig As Long
 Dim tablo(), tabloR(), k, i

 Application.ScreenUpdating = False

    With poOnglet
             .Activate
             derlig = .Range("B" & Rows.Count).End(xlUp).Row
     If Range("G2") <> "HT goal" Then Exit Sub
              tablo = Range("G3:G" & derlig)
       .Cells(2, 7) = "H HT G": .Cells(2, 7).Font.Bold = True
       .Cells(2, 8) = "A HT G": .Cells(2, 8).Font.Bold = True

         k = 0
      For i = 1 To UBound(tablo, 1)
         ReDim Preserve tabloR(1, 1 To k + 1)
            tabloR(0, k + 1) = Mid(tablo(i, 1), 2, 1)
            tabloR(1, k + 1) = Mid(tablo(i, 1), 6, 1)
            k = k + 1
      Next i
      On Error Resume Next
      .Range("G2").Offset(1, 0).Resize(UBound(tabloR, 2), 2) = Application.Transpose(tabloR)
       Erase tabloR
   End With
End Sub

Public Sub Separation_HT()
    Dim oSh As Worksheet
     For Each oSh In ActiveWindow.SelectedSheets
        Test oSh
     Next oSh
End Sub

Cordialement,