Recopie Cle USB

[Bruce68]

Bonjour à tous
Ce que je cherche à faire c'est recopier des données de plusieurs clés USB l'une au bout de l'autre en pouvant choisir l'emplacement de la clé USB et que la recopie de la 2° lé USB se fasse au bout de la 1° ainsi de suite jusqu'à la dernière et cela dans la feuille score en commençant dans la cellule "A1".
Le nombre de ligne dans la clé USB peut être de 2 à 15 environ, la premiere ligne :Score sera sur chaque clé USB cela n'est pas gênant
La macro faite en auto ne me satisfait pas (EXCEL 2010)
Ci joint le fichier Excel et 2 fichiers textes pour mettre sur clé USB qui représente ce que je dois enregistrer.
Je vous remercie de votre aide

 

[Bruce68]

Re bonjour à tous
N'ayant pas de réponse j'ai travaillé sur une macro celle ci fonctionne bien sur mon fichier original qui comporte plusieurs onglets mais dans le fichier joint impossible de la faire fonctionner (1 seul onglet) .
Un 2° problème ce greffe quand je recopie le deuxième fichier texte la 1° recopie s'efface et je ne sais pas pourquoi.
Une âme charitable pourrait elle se pencher sur mon problème.
Je vous remercie de votre aide

 

[vgendron]

Hello

je me suis penché. juste un peu.
essaie de remplacer

ChDir ThisWorkbook.Path

par

ChDir activeWorkbook.Path

 

[vgendron]

ah. et j'ignore comment tu as fait pour avoir un Thisworkbook et un Thisworkbook1 dans ton classeur VBA. mais ca ne me semble pas trop normal..??

1° recopie s'efface et je ne sais pas pourquoi.

il me semble avoir vu un cells.clear dans ton code qui pourrait expliquer cela..

 

[JCGL]

Bonjour à tous,

Peux-tu essayer :

Sub RecopieScore()
Dim Fichier As Variant
    ChDir ActiveWorkbook.Path & "\"
    Fichier = Application.GetOpenFilename("Text Files (*.txt), *.txt")
        If Fichier <> False Then
        Lire Fichier
    End If
End Sub

Function Lire(ByVal NomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur  As String * 1
    '  Séparateur Tabulation
    Separateur = Chr(9)
    'Cells.Clear
    NumFichier = FreeFile
    iRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    Open NomFichier For Input As #NumFichier
        Do While Not EOF(NumFichier)
            iCol = 1
            Line Input #NumFichier, Chaine
            Ar = Split(Chaine, Separateur)
            For i = LBound(Ar) To UBound(Ar)
                Cells(iRow, iCol) = Ar(i)
                iCol = iCol + 1
             Next
            iRow = iRow + 1
        Loop
    Close #NumFichier
End Function

A+ à tous

 

[Bruce68]

Bonsoir JCGL et le forum
La macro jointe fonctionne parfaitement , merci beaucoup pour ton aide.
Tous mes problèmes sont résolus.
Bonne soirée à tous.