Macro qui copie les lignes des fichiers ds nouveau fichier

merci beaucoup ca marche du feu de Dieu!
est-ce qu il est possible de couper coller des fichiers d un dossier a un autre sans les copier? pour qu ils disparaissent bien au moment ou ils ont ete colle

merci

Bonjour
est-ce qu il est possible de couper coller des fichiers d un dossier a un autre sans les copier? pour qu ils disparaissent bien au moment ou ils ont ete colle Voulez-vous dire "déplacer les fichiers"? OUI on peut
Y a t-il un rapport avec la question initiale?
Donnez plus de précisions
Cdlt

ok voici ma macro, le but c est de deplacer des fichiers d un dossier vers un autre dossier . les fichiers du premier dossier sont generes par une autre macro qui les range automatiquement dans ce dossier 1 et donc peuvent arriver a tout moment. ensuite cette macro copierai les lignes des fichiers non vides dans un nouveau dossier.

voila ce que jai fait grace a votre aide:

Et maintenant jaimerai changer la premiere etape du copier coller supprimer par deplacer les fichiers du dossier vers un autre. au cas ou un fichier arrive dans le dossier quand la macro est en train de tourner

Sub Copy_Folder()
'cette macro copie les fichiers d'un repertoire dans un autre dossier

Dim Fso As Object
Dim FromPath As String
Dim ToPath As String

FromPath = "C:\Users\Louise\Documents\MACCCRRRROOOO\dossier test 1"
ToPath = "C:\Users\Louise\Documents\MACCCRRRROOOO\dossier test 2"


If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If

If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If

Set Fso = CreateObject("scripting.filesystemobject")

If Fso.FolderExists(FromPath) = False Then

Exit Sub
End If

Fso.CopyFolder Source:=FromPath, Destination:=ToPath


'supprimer les fichiers dans le premier fichier

On Error Resume Next
Kill "C:\Users\Louise\Documents\MACCCRRRROOOO\dossier test 1\*.*"
On Error GoTo 0

'trouve le nom des fichiers
Dim Rep As String, Fichier As String
Dim j As Integer

Rep = "C:\Users\Louise\Documents\MACCCRRRROOOO\dossier test 2\"
Fichier = Dir(Rep)
Do While Fichier <> ""
j = j + 1
Sheets("Liste").Range("C" & j + 1) = Fichier
Fichier = Dir
Loop

'ouvre dossier et recopie les lignes non vides

Dim FichierAOuvrir
Dim i As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set F1 = Sheets("Liste")
Set F2 = Sheets("RecupDesDonnees")

F1.Select
ChDrive Cells(2, 1)
Chemin = Cells(2, 2) & "\"
ReDim FichierAOuvrir([C1000].End(xlUp).Row - 1) As String
NbFichiers = [C1000].End(xlUp).Row - 1
For i = 1 To NbFichiers
If Cells(i + 1, 3) = "" Then GoTo Recup
FichierAOuvrir(i) = Cells(i + 1, 3)
Next i

Recup:
F2.Select
For i = 1 To NbFichiers
Workbooks.Open Chemin & FichierAOuvrir(i), corruptload:=xlRepairFile
Range(Cells(2, 1), Cells([B65535].End(xlUp).Row, [IV1].End(xlToLeft).Column)).Select
Selection.Copy
ActiveWorkbook.Close
PremLigne = [C65535].End(xlUp).Row + 1
Range("A" & PremLigne).Select
ActiveSheet.Paste
Next i

'suppression des lignes vides
DerLig = [A100000].End(xlUp).Row
For i = 2 To DerLig
If Cells(i, 1) <> "" Then GoTo Suivant
Cells(i, 1).EntireRow.Delete
i = i - 1
DerLig = DerLig - 1
If DerLig < i Then Exit Sub
Suivant:
Next i

'supprime les doublons
MaCellule = ("B1")
Range(MaCellule).Select
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select

While ActiveCell <> ""
If ActiveCell = donnee1 Then
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
Else
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
End If
Wend

End Sub

Re
essayez ceci

Sub DeplacerFichier()
    Set objOFS = CreateObject("Scripting.FileSystemObject")
    CheminActuel = "C:\Users\Louise\Documents\MACCCRRRROOOO\dossier test 1"
    If Right(CheminActuel, 1) <> "\" Then CheminActuel = CheminActuel & "\"
    NouveauChemin = "C:\Users\Louise\Documents\MACCCRRRROOOO\dossier test 1"
    If Right(NouveauChemin, 1) <> "\" Then NouveauChemin = NouveauChemin & "\"
    
    Fichier = Dir(CheminActuel, vbNormal)
    Do While Fichier <> ""
        Name CheminActuel & Fichier As NouveauChemin & Fichier
        Fichier = Dir
    Loop
End Sub

A adapter à votre code
dlt

Merci ca marche mais par contre quand je l integre dans l ecriture les etapes suivantes ne s activent plus
jai remplace tout le copier coller supprimer par ce que vous m avez envoyee et garder la suite identique

merci encore

en fait le programme s arrete a l etape
'trouve le nom des fichiers
pourtant les fichiers se trouve bien dans le nouveau repertoire
je suis bloquee
merci pr votre aide en tout cas