Discussion :

[manu900]

Bonjour à tous,

Je vous sollicite car je n'arrive pas à réaliser l'opérations que je souhaite. Explication :

J'ai un fichier qui s'apelle Test contenant 3 feuilles :
. Sur ces 3 feuilles, la première ligne est identique pour chacune d'elles.
. Contenu différent.
. Certaines cellules des 3 premières colonnes sont fusionnées.

Je souhaiterai copier le contenu des trois feuilles (jusqu'a la dernière cellule de la colonne B) vers une seule feuille dans autre classeur.
De plus lorsque le copier/coller des feuilles est terminé, je souhaite appliquer la fonction unmerge sur les cellules fusionner et copié le contenu des cellules qui était fusionné.

Voilà mon code, simplement c'est qu'il y a une erreur et je n'arrive pas à trouver la solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Copier()
 
Dim LastLig As Long
 
With Workbooks("Test.xlsm")
 
Var_Chemin = "C:\CopieTest.xlsx"
fichier1 = ActiveWorkbook.Name
Workbooks.Open Var_Chemin, 0, ReadOnly:=False
Fichier2 = ActiveWorkbook.Name
LastLig = Worksheets.Cells(.Rows.Count, "B").End(xlUp).Row
 
For lngCount = 1 To Workbooks(fichier1).Worksheets.Count
 
 
Workbooks(fichier1).Sheets(lngCount).Range("A1:E" & LastLig)Copy Before:=Workbooks(Fichier2).Sheets("Feuil1")
 
Next
End With
End Sub

Voici également les fichiers:Test.xlsx
CopieTest.xlsx.

J'èspere avoir été précis, en tout cas je vous remercie d'avance pour vos réponse.

Bonne journée.

[Daniel.C]

Bonjour,

La syntaxe de cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks(fichier1).Sheets(lngCount).Range("A1:E" & LastLig)Copy Before:=Workbooks(Fichier2).Sheets("Feuil1")

sert à copier une feuille de plus, il faut un point avant "Copy". Si c'est le cas, il faut enlever :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1:E" & LastLig)

En effet, c'est toute la feuille que tu copies, y compris les éventuelles macros.

[manu900]

Bonjour Daniel et Mercatog

Merci pour vos réponses.
En effet, vos solutions fonctionne.

Cependant, j'aimerais juste copier tous le contenus des 3 feuilles dans une seule feuille qui se trouve sur autre classeur. C'est à dire mettre les tableaux à la suite des autres dans une unique feuille.

Cordialement.

[Daniel.C]

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Copier()
 
Dim LastLig As Long, Ligne As Long
 
With Workbooks("Test.xlsm")
 
Var_Chemin = "C:\CopieTest.xlsx"
fichier1 = ActiveWorkbook.Name
Workbooks.Open Var_Chemin, 0, ReadOnly:=False
Fichier2 = ActiveWorkbook.Name
Ligne = 1
For lngCount = 1 To Workbooks(fichier1).Worksheets.Count
 
LastLig = Worksheets.Cells(.Rows.Count, "B").End(xlUp).Row
Workbooks(fichier1).Sheets(lngCount).Range("A1:E" & LastLig).Copy Workbooks(Fichier2).Sheets("Feuil1").Cells(Ligne, 1)
Ligne = Workbooks(Fichier2).Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row + 1
 
Next
End With
End Sub

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Copier()
Dim Wbk As Workbook
Dim Ws As Worksheet
Dim Chemin As String
Dim NewLig As Long
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
    With Wbk.Worksheets(1)
        For Each Ws In ThisWorkbook.Worksheets
            NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            Ws.UsedRange.Copy .Range("A" & NewLig)
        Next Ws
    End With
    Wbk.Close True
    Set Wbk = Nothing
    MsgBox "Copie terminée"
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
End Sub

[manu900]

Après de multiples essaies, le code se bloque pour les deux méthodes (Daniel et Mercatog) au même niveau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
LastLig = Worksheets.Cells(.Rows.Count, "B").End(xlUp).Row
NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1

Merci à vous deux.

[Daniel.C]

Ce n'est pas ce que j'ai écrit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Ligne = Workbooks(Fichier2).Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row + 1

Tu pourrais aussi dire quel est le message d'erreur.

[mercatog]

Quelque chose comme ceci (copie de toutes les feuilles du fichier contenant la macro vers le fichier CopieTest)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Copier()
Dim Wbk As Workbook
Dim Ws As Worksheet
Dim Chemin As String
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
    For Each Ws In ThisWorkbook.Worksheets
        Ws.Copy Before:=Wbk.Worksheets("Feuil1")
    Next Ws
    Wbk.Close True
    Set Wbk = Nothing
    MsgBox "Copie terminée"
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
End Sub