[VBA] Pb de copiage de ligne bien spécifique

Question

Bonjour,

Voila mon problème (hors mis que je suis totalement novice en vba :D) :

J'ai 1043 fichiers excel qui présente la même forme de tableau mais avec des valeurs différentes bien sûr.
J'aimerai pouvoir copier la ligne 48 de chaque fichier et les coller dans un nouveau fichier excel "ClasseurTemp.xslm" 


voila le code que j'ai pondu, mais ca ne marche pas.

Sub copie48()

Dim wb As Workbook
Dim ws As Worksheet
Dim i As Integer


For Each wb In Application.Workbooks
i = 1
'For Each ws In wb.Worksheets

    
    Rows("48:48").Select
    Selection.Copy
    Windows("ClasseurTemp.xlsm").Activate
    Rows("i:i").Select
    ActiveSheet.Paste
    
    
    i = i + 1


'Next ws

Next wb

End Sub


Donc di quelqu'un pouvait me depanner ca serait très sympa.
merci d'avance
jaybee

Ivan-hoe · Answer

Bonjour, 
pour que ton code ci-dessus marche, il faut que tes 1043 fichiers et ton ClasseurTemp soient ouverts quand tu exécutes ta macro.
de plus, déplace l'instruction i = 1 AVANT For Each wb ; sinon, tu remets ton i à 1 à chaque classeur et tu écrases systématiquement ta ligne 1. 

Si tes 1043 fichiers sont facilement identifiables (tous dans le même répertoire, ou avec des noms qui contiennent tous la même racine), utilise une boucle pour les ouvrir un par un, faire ton traitement et les fermer. 
Regarde l'instruction Dir dans l'aide VBA. 
I.

lermite222 · Answer

Bonjour,
Un pti coup de pouce supplémentaire...
Sub Recupfile()
Dim fs, F, f1, s, sf
Dim Ext As String, Chemin As String
Dim i As Integer, Nom As String
    Ext = "xls" 'Pour des fichier Excel
    Chemin = "C:\" 'Le répertoir à parcourir
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then
            'Adapté les adresses cellules.
            Nom = f1.Name
            Workbooks(Nom).Open
                'Ici Faire la copie
            Workbooks(Nom).Close
        End If
        i = i + 1
    Next
End Sub
A+

[VBA] Pb de copiage de ligne bien spécifique

2 réponses

Discussions similaires

Newsletters