[VBA] Bug de collage!!!!!

Question

Bonjour,

Je voudrais automatiser un fichier excel et mon bout de code consisterait a recuperer deux plages situés loin l'une de l'autre dans la page et de les coller dans une autre page mais je n'arrive pas il colle une seule partie et en oublie une autre qui peut m'aider???? 



Feuille_enCours = Chemin_Files & "\" & QueryN4_File(i) & ".txt" ' Repositionne le contenu 

Dim trouve1 As Boolean 
Dim trouve2 As Boolean 
Dim Index_ligne As Integer 
Dim index_section_femme As Integer 
Dim index_section_homme As Integer 
Dim value As Variant 
Dim cherche As Variant 

trouve = False 
Index_ligne = 1 
value = "Valeurs minimales" 

Do While trouve1 = False Or trouve2 = False 
cherche = Sheets(Feuille_enCours).Cells(Index_ligne, 1) 
If value = cherche Then trouve1 = True 
index_section_homme = Index_ligne 

If trouve1 = True Then cherche = "" 
Do While trouve2 = False 
cherche = Sheets(Feuille_enCours).Cells(Index_ligne, 1) 
If value = cherche Then trouve2 = True 
index_section_femme = Index_ligne 
Index_ligne = Index_ligne + 1 
Loop 
Index_ligne = Index_ligne + 1 
Loop 

.......... 
.......... 
......... 

Feuille_enCours = Chemin_Files & "\" & QueryN4_File(i) & ".txt" 

Workbooks(Feuille_enCours).Activate 
Sheets(QueryN4_File(i)).Select 
Range(Cells(index_section_femme, 6), Cells(index_section_femme + 9, 24)).Select 
Selection.Copy 
Workbooks(File_Out_N4).Activate 
Sheets(Nom_Adr_Query_N4(i)).Select 
Cells.Select 
Range(Cells(10, 4), Cells(20, 17)).Select 
ActiveSheet.Paste 


Feuille_enCours = Chemin_Files & "\" & QueryN4_File(i) & ".txt" 

Workbooks(Feuille_enCours).Activate 
Sheets(QueryN4_File(i)).Select 
Range(Cells(index_section_homme, 6), Cells(index_section_homme + 9, 24)).Select 
Selection.Copy 
Workbooks(File_Out_N4).Activate 
Sheets(Nom_Adr_Query_N4(i)).Select 
Cells.Select 
Range(Cells(22, 4), Cells(31, 17)).Select 
ActiveSheet.Paste 

Workbooks(NomSheet & ".txt").Activate 'Active fichier txt

Utilisateur anonyme · Answer

Bonjour,

je n'ai pas tout compris et ne peux tester le code, mais voici quelques explications:


Option Explicit

Sub Test()


    Dim trouve1 As Boolean
    Dim trouve2 As Boolean
    Dim Index_ligne As Integer
    Dim index_section_femme As Integer
    Dim index_section_homme As Integer
    Dim valeur As Variant ' value est un mot réservé de VBA
                          ' Pourquoi variant, tu initialise avec
                          'une chaine de caractère [ String ]
    Dim cherche As Variant
    Dim Feuille_enCours As String

    Feuille_enCours = Chemin_Files & "\" & QueryN4_File(i) & ".txt" ' Repositionne le contenu

    trouve1 = False
    Index_ligne = 1
    valeur = "Valeurs minimales"

    Do While ((trouve1 = False) Or (trouve2 = False))
    ' Les test boolean sont implicite
    'Do While (Not (trouve1) Or Not (trouve2))
        cherche = Sheets(Feuille_enCours).Cells(Index_ligne, 1)
        If (valeur = cherche) Then trouve1 = True
        index_section_homme = Index_ligne

        If (trouve1 = True) Then cherche = ""
        'If (trouve1) Then cherche = "" ' Le test [ = True ] est implicite
        
        Do While Not (trouve2)
            cherche = Sheets(Feuille_enCours).Cells(Index_ligne, 1)
            If (valeur = cherche) Then trouve2 = True
            index_section_femme = Index_ligne
            Index_ligne = Index_ligne + 1
        Loop
        Index_ligne = Index_ligne + 1
    Loop

    '..........
    '..........
    '.........

    Feuille_enCours = Chemin_Files & "\" & QueryN4_File(i) & ".txt"

    Workbooks(Feuille_enCours).Activate
    Sheets(QueryN4_File(i)).Select
    Range(Cells(index_section_femme, 6), Cells(index_section_femme + 9, 24)).Select
    Selection.Copy
    Workbooks(File_Out_N4).Activate
    Sheets(Nom_Adr_Query_N4(i)).Select
    Cells.Select
    Range(Cells(10, 4), Cells(20, 17)).Select
    ActiveSheet.Paste


    Feuille_enCours = Chemin_Files & "\" & QueryN4_File(i) & ".txt"

    Workbooks(Feuille_enCours).Activate
    Sheets(QueryN4_File(i)).Select
    Range(Cells(index_section_homme, 6), Cells(index_section_homme + 9, 24)).Select
    Selection.Copy
    Workbooks(File_Out_N4).Activate
    Sheets(Nom_Adr_Query_N4(i)).Select
    Cells.Select
    Range(Cells(22, 4), Cells(31, 17)).Select
    ' Un paste se fait toujours sur une seule cellule
    ActiveSheet.Paste

    Workbooks(NomSheet & ".txt").Activate 'Active fichier txt

End Sub
'

Sub CopierColler()

    Dim Plage As String
    
    Set Plage = Range("A4:B8", "C10:D44")
    
    Plage.Select
    
    Worksheets.Add
    
    Range("A4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
End Sub
'


Lupin

[VBA] Bug de collage!!!!!

1 réponse

Discussions similaires

Newsletters