Discussion :

[Hottois]

Bonjour,

J'ai trouvé cette macro qui ouvre les fichiers .txt sélectionnés dans différents onglets d'un nouveau workbook. J'aimerais modifier cette macro pour que les fichiers .txt sélectionnés s'ouvrent dans de nouveaux onglets mais du workbook actuel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub CombineTextFiles()
    Dim xFilesToOpen As Variant
    Dim i As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Sélectionner vos fichiers", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Excel"
        GoTo ExitHandler
    End If
 
    Set xWb = ThisWorkbook
    i = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(i))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(i).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    Do While i < UBound(xFilesToOpen)
        i = i + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(i))
        With xWb
            xTempWb.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(i).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=xDelimiter
        End With
    Loop
 
 
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Excel"
    Resume ExitHandler
End Sub

Merci pour votre aide.

[Hottois]

Pour les intéressés, voici le code final.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub CombineTextFiles()
    Dim xFilesToOpen As Variant
    Dim i As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Sélectionner vos fichiers", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Excel"
        GoTo ExitHandler
    End If
 
    Set xWb = ThisWorkbook
    Do While i < UBound(xFilesToOpen)
        i = i + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(i))
        With xWb
            xTempWb.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(i).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=xDelimiter
        End With
    Loop
 
 
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Excel"
    Resume ExitHandler
End Sub

Bonne journée.