Scinder un fichier texte avant importation dans Excel

Re le forum

Maguetlolo, avec un With Feuille, il ne faut pas oublier le . (point) devant la suite de code.

With Feuille 
    .Columns("I:I").Copy 
    .Columns("J:J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
        :=False, Transpose:=False 
End With

Ta macro corrigée, pourrait ressembler à ceci

Sub Correction()

For Each Feuille In Worksheets

If Feuille.Name Like "abc2*" Then

With Feuille
    .Columns("J:J").Value = .Columns("I:I").Value
    .Columns("J:J").TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 9), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    .Columns("J:CS").EntireColumn.AutoFit
    .Columns("I:J").EntireColumn.Hidden = True
End With

End If

Next Feuille

End Sub

Mytå

Bonjour,

merci, ca marche tres bien,

cordialement

Bonjour

suite de mes modifs

Comme pour les autres, il faudrais qu'elle prenne en compte tout les feuilles se nommant "abc2*" (j'ai essayé mais bien sur, je n'y suis pas arrivé)

Il faudrais modifier car il faut lorsqu'elle traite la feuille "ABC2*" suivante qu'elle mette les lignes copiées à la suite des autres

Sub fluxAZ00()

Dim Unique As Object, cel As Range
Set Unique = CreateObject("Scripting.Dictionary")
Sheets("fluxAZ001").Cells.Delete
Sheets("fluxAZ002").Cells.Delete
Sheets("doublons").Cells.Delete
Columns("G:G").Interior.ColorIndex = xlNone
    For Each cel In Range("G1:G" & [G65000].End(xlUp).Row)
        If Not Unique.Exists(cel.Offset(0, -3).Value & cel.Value) Then
        Unique.Add cel.Offset(0, -3).Value & cel.Value, cel.Offset(0, -3).Value & cel.Value
        'Traitement de AZ001 et AZ002
        If cel.Offset(0, -3) = "CCC_CC" Then
            Select Case cel.Offset(0, -1).Value
            Case "AZ001"
                Range(Cells(cel.Row, 1), Cells(cel.Row, 9)).Copy
                With Sheets("fluxAZ001").Range("A" & Sheets("fluxAZ001").Range("A65535").End(xlUp).Row + 1)
                    .PasteSpecial Paste:=xlPasteAll
                    .PasteSpecial Paste:=xlPasteColumnWidths
                End With
                Application.CutCopyMode = False
            Case "AZ002"
                Range(Cells(cel.Row, 1), Cells(cel.Row, 9)).Copy
                With Sheets("fluxAZ002").Range("A" & Sheets("fluxAZ002").Range("A65535").End(xlUp).Row + 1)
                    .PasteSpecial Paste:=xlPasteAll
                    .PasteSpecial Paste:=xlPasteColumnWidths
                End With
                Application.CutCopyMode = False
            End Select
        End If
        Else
        'Traitement des doublons
        If Not IsEmpty(cel) And _
        cel.Offset(0, -3) = "CCC_CC" And _
        (cel.Offset(0, -1) = "AZ001" Or cel.Offset(0, -1) = "AZ002") Then
        'Cel.Interior.ColorIndex = 3
            Range(Cells(cel.Row, 1), Cells(cel.Row, 9)).Copy
            With Sheets("doublons").Range("A" & Sheets("doublons").Range("A65535").End(xlUp).Row + 1)
                .PasteSpecial Paste:=xlPasteAll
                .PasteSpecial Paste:=xlPasteColumnWidths
            End With
            Application.CutCopyMode = False
        End If
        End If
    Next cel
Set Unique = Nothing
End Sub

cordialement

Salut le forum

Mageutlolo, travailler à l'aveuglette encore un fois...............

Essaye de joindre à tes questions, un bout de fichier

Il faut deviner à toutes les fois ta dispostion, le nom des feuilles.....

Mytå

Salut le forum

Maguetlolo, essaye avec se bout de code

Sub fluxAZ00() 
Dim Unique As Object, cel As Range 
Set Unique = CreateObject("Scripting.Dictionary") 
Sheets("fluxAZ001").Cells.Delete 
Sheets("fluxAZ002").Cells.Delete 
Sheets("doublons").Cells.Delete 
Columns("G:G").Interior.ColorIndex = xlNone 

For Each Feuille In Worksheets 

If Feuille.Name Like "abc2*" Then 
Feuille.Activate 
    For Each cel In Range("G1:G" & [G65000].End(xlUp).Row) 
        If Not Unique.Exists(cel.Offset(0, -3).Value & cel.Value) Then 
        Unique.Add cel.Offset(0, -3).Value & cel.Value, cel.Offset(0, -3).Value & cel.Value 
        'Traitement de AZ001 et AZ002 
        If cel.Offset(0, -3) = "CCC_CC" Then 
            Select Case cel.Offset(0, -1).Value 
            Case "AZ001" 
                Range(Cells(cel.Row, 1), Cells(cel.Row, 30)).Copy 
                With Sheets("fluxAz001").Range("A" & Sheets("fluxAZ001").Range("A65535").End(xlUp).Row + 1) 
                    .PasteSpecial Paste:=xlPasteAll 
                    .PasteSpecial Paste:=xlPasteColumnWidths 
                End With 
                Application.CutCopyMode = False 
            Case "CP002" 
                Range(Cells(cel.Row, 1), Cells(cel.Row, 30)).Copy 
                With Sheets("fluxAZ002").Range("A" & Sheets("fluxAZ002").Range("A65535").End(xlUp).Row + 1) 
                    .PasteSpecial Paste:=xlPasteAll 
                    .PasteSpecial Paste:=xlPasteColumnWidths 
                End With 
                Application.CutCopyMode = False 
            End Select 
        End If 
        Else 
        'Traitement des doublons 
        If Not IsEmpty(cel) And _ 
        cel.Offset(0, -3) = "CCC_CC" And _ 
        (cel.Offset(0, -1) = "AZ001" Or cel.Offset(0, -1) = "AZ002") Then 
        'Cel.Interior.ColorIndex = 3 
            Range(Cells(cel.Row, 1), Cells(cel.Row, 30)).Copy 
            With Sheets("doublons").Range("A" & Sheets("doublons").Range("A65535").End(xlUp).Row + 1) 
                .PasteSpecial Paste:=xlPasteAll 
                .PasteSpecial Paste:=xlPasteColumnWidths 
            End With 
            Application.CutCopyMode = False 
        End If 
        End If 
    Next cel 
End If 
Next Feuille 
Set Unique = Nothing 
End Sub

Mytå