Copier/coller entre deux fichiers

Le 26/02/2020 à 16:03

Bonjour à tous,

Je souhaite copier coller plusieurs fichiers dans une feuille d'un autre fichier. Cependant, je n'arrive pas à écrire un code qui me permettent de coller à la suite sans écraser les premières données collées (du 1er fichier). Il s'agit de fichiers .txt où je souhaite copier les colonnes A à CR.

Voici mon code:

Sub OpenImportFile()
    Dim sFileName As String
    Dim sBase As String, test As String
    Dim sSuffix As String
    Dim sExt As String
    Dim shA As Worksheet
    Dim i As Integer
Dim dtDébut As Double, dtFin As Double, n  As Integer
Dim dt As Double

  Set shA = ThisWorkbook.Worksheets("Data")
  shA.Cells.ClearContents

dtDébut = Worksheets("Paramètres").Range("B9").Value
dtFin = Worksheets("Paramètres").Range("B10").Value
n = dtFin - dtDébut
  For i = 0 To n - 1
    dt = Format(dtDébut + i, "yyyymmdd")
    sBase = "F:\Ordinateur\Bonjour2020\"
    sExt = "bjx.fic"
    sFileName = sBase & dt & sExt

    test = Dir(sFileName)
    If test <> "" Then

        Workbooks.OpenText sFileName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, Local:=True, DecimalSeparator:="."
        Columns("A:CR").Copy

    ThisWorkbook.Sheets("Data").Activate
    ActiveSheet.Paste

       End If
   Next

End Sub
Le 26/02/2020 à 16:14

Bonjour Fizuaal, bonjour le forum,

Peut-être comme ça :

Sub OpenImportFile()
Dim sFileName As String
Dim sBase As String, test As String
Dim sSuffix As String
Dim sExt As String
Dim shA As Worksheet
Dim i As Integer
Dim dtDébut As Double, dtFin As Double, n  As Integer
Dim dt As Double
Dim DEST As Range

Set shA = ThisWorkbook.Worksheets("Data")
shA.Cells.ClearContents

dtDébut = Worksheets("Paramètres").Range("B9").Value
dtFin = Worksheets("Paramètres").Range("B10").Value
n = dtFin - dtDébut
For i = 0 To n - 1
    dt = Format(dtDébut + i, "yyyymmdd")
    sBase = "F:\Ordinateur\Bonjour2020\"
    sExt = "bjx.fic"
    sFileName = sBase & dt & sExt
    test = Dir(sFileName)
    If test <> "" Then
        Workbooks.OpenText sFileName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, Local:=True, DecimalSeparator:="."
        Set DEST = IIf(shA.Range("A1").Value = "", shA.Range("A1"), shA.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
        Columns("A:CR").Copy DEST
    End If
Next
End Sub
Le 26/02/2020 à 16:24

Bonjour ThauTheme et merci beaucoup pour ton aide,

Cependant, le collage ne semble pas réussir (voir photo):

capture3 capture
Le 26/02/2020 à 16:49

Re,

Sans fichier difficile de voir ce qui cloche...

Le 26/02/2020 à 16:59

Le fichier en pj,

5import-csv-test.xlsm (31.35 Ko)
Le 26/02/2020 à 17:14

Re,

Heu... Il me semble avoir déjà bossé sur un fil similaire... En fait ce qu'il me faut c'est un fichier txt (je ne sais pas si je pourrais ouvrir un fic).

Le 26/02/2020 à 17:22

Voila, j'ai supprimé les données sensibles et beaucoup de lignes pour avoir une taille de fichier correct.

Merci!

1fichier-source.zip (1.85 Ko)
Le 26/02/2020 à 18:56

Re,

À l'ouverture, la mise en colonne du fichier texte ne se fait pas. J'ai modifié le code mais je suis sceptique :

Sub OpenImportFile()
Dim sFileName As String
Dim sBase As String, test As String
Dim sSuffix As String
Dim sExt As String
Dim shA As Worksheet
Dim I As Integer
Dim DEST As Range
Dim dtDébut As Double, dtFin As Double, n  As Integer
Dim dt As Double

Set shA = ThisWorkbook.Worksheets("Data")
shA.Cells.ClearContents
dtDébut = Worksheets("Paramètres").Range("B9").Value
dtFin = Worksheets("Paramètres").Range("B10").Value
n = dtFin - dtDébut
For I = 0 To n - 1
  dt = Format(dtDébut + I, "yyyymmdd")
  sBase = "F:\Fastnet\Fastnet2020\"
  sExt = "FastnetI.fic"
  sFileName = sBase & dt & sExt

  test = Dir(sFileName)
  If test <> "" Then
          sFileName = "C:\Users\Robert\Documents\Poubelle\fichier source.txt"
          Workbooks.OpenText sFileName, DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
          Semicolon:=True, Comma:=False, Space:=False, Other:=False, Local:=True, DecimalSeparator:="."
          Set DEST = IIf(shA.Range("A1").Value = "", shA.Range("A1"), shA.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
          ActiveWorkbook.Worksheets(1).Cells.Copy DEST
    End If
 Next
End Sub
Le 26/02/2020 à 19:03

Merci,

Autre soucis:

capture
Le 26/02/2020 à 19:37

Re,

Ben oui ! J'suis bête !... Peut-être comme ça alors :

Sub OpenImportFile()
Dim sFileName As String
Dim sBase As String, test As String
Dim sSuffix As String
Dim sExt As String
Dim shA As Worksheet
Dim I As Integer
Dim DEST As Range
Dim dtDébut As Double, dtFin As Double, n  As Integer
Dim dt As Double

Set shA = ThisWorkbook.Worksheets("Data")
shA.Cells.ClearContents
dtDébut = Worksheets("Paramètres").Range("B9").Value
dtFin = Worksheets("Paramètres").Range("B10").Value
n = dtFin - dtDébut
For I = 0 To n - 1
  dt = Format(dtDébut + I, "yyyymmdd")
  sBase = "F:\Fastnet\Fastnet2020\"
  sExt = "FastnetI.fic"
  sFileName = sBase & dt & sExt

  test = Dir(sFileName)
  If test <> "" Then
          sFileName = "C:\Users\Robert\Documents\Poubelle\fichier source.txt"
          Workbooks.OpenText sFileName, DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
          Semicolon:=True, Comma:=False, Space:=False, Other:=False, Local:=True, DecimalSeparator:="."
          Set DEST = IIf(shA.Range("A1").Value = "", shA.Range("A1"), shA.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
          ActiveWorkbook.Worksheets(1).UsedRange.Copy DEST
    End If
 Next
End Sub
Le 26/02/2020 à 20:34

Incroyable!! Merci beaucoup, ca marche!

Le 27/02/2020 à 09:20

Rebonjour Thautheme,

juste une dernière petite request: saurais-tu comment ne seulement copier les lignes qui comporte un "mot" spécifique dans la colonne L ?

Cela me permettrait de réduire les données importées.

Le 27/02/2020 à 09:50

Re,

Non car quand je teste, la mise en colonne ne se fait pas. J'ai tout dans la colonne A. Mais je n'ai pas essayé avec le véritable fichier .fic...

Le 27/02/2020 à 10:00

Bonjour ThauTheme,

Je te joins un fichier .txt original (mon code ouvre en txt). Il faudrait juste changer la variable:

sExt = "FastnetI.fic" en "FastnetI.txt" , pour que ca marche de ton coté

220200222fastneti.zip (4.89 Ko)
Le 27/02/2020 à 10:42

Re,

J'ai toujours le même problème, la mise en colonne ne se fait pas. Je la fait manuellement avec l'onglet Données / Convertir... Mais si on considère que chez toi ça marche le code ci-dessous devrait fonctionner. Toutefois, tu dis :

fizuaal a écrit :

juste une dernière petite request: saurais-tu comment ne seulement copier les lignes qui comporte un "mot" spécifique dans la colonne L ?

C'est tellement vague que je me suis cru sur la plage de Sète... Dans le code j'ai pris au hasard la valeur de la ligne 4 : CACEIS Bank et utilisé Trim pour supprimer tous les espaces à la c**. Si le mot spécifique est fixe tu n'auras plus qu'à le remplacer, sinon il faudra passer par une InputBox qui demandera à l'utilisateur de taper le mot critère du filtre :

Le code :

Sub OpenImportFile()
Dim sFileName As String
Dim sBase As String, test As String
Dim sSuffix As String
Dim sExt As String
Dim shA As Worksheet
Dim I As Integer
Dim DEST As Range
Dim dtDébut As Double, dtFin As Double, n  As Integer
Dim dt As Double
Dim CS As Workbook
Dim OS As Worksheet
Dim PL As Range

Set shA = ThisWorkbook.Worksheets("Data")
shA.Cells.ClearContents
dtDébut = Worksheets("Paramètres").Range("B9").Value
dtFin = Worksheets("Paramètres").Range("B10").Value
n = dtFin - dtDébut
For I = 0 To n - 1
    dt = Format(dtDébut + I, "yyyymmdd")
    sBase = "F:\Fastnet\Fastnet2020\"
    sExt = "FastnetI.fic"
    sFileName = sBase & dt & sExt
    'sFileName = "Z:\poubelle\20200222FastnetI.txt" 'pour les tests
    test = Dir(sFileName)
    If test <> "" Then
        Workbooks.OpenText sFileName, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, Local:=True, DecimalSeparator:="."
        Set CS = ActiveWorkbook
        Set OS = CS.Worksheets(1)
        Set PL = OS.Range("A1").CurrentRegion
        PL.AutoFilter Field:=12, Criteria1:=Trim(OS.Range("L4").Value)
        Set DEST = IIf(shA.Range("A1").Value = "", shA.Range("A1"), shA.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
        PL.SpecialCells(xlCellTypeVisible).Copy DEST
        PL.AutoFilter
        CS.Close False
     End If
Next I
End Sub
Le 27/02/2020 à 11:52

Merci énormément,

Je pense que tout les espaces à la cons proviennent du fait que ton séparateur décimal ne soit pas "."?

Merci beaucoup en tout cas,

Rechercher des sujets similaires à "copier coller entre deux fichiers"