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.
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,