Discussion :

[juju05]

Je souhaite recopier des tableaux positionnés sur 2 feuilles du même classeur et les coller dans la feuille 1.

Pour cela, je fais:

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
 
   ' j'active le prese-papier
   Application.CommandBars("Clipboard").Visible = True
 
   For NUM_FEUILLE = 2 To Worksheets.Count
       Worksheets(NUM_FEUILLE).Select
       Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
       If NUM_FEUILLE > 2 Then
          Application.CutCopyMode = False
       End If
       Selection.Copy
   Next NUM_FEUILLE
 
   Worksheets(1).Select
   Range("A1").Select
   ActiveSheet.Paste

Cela ne fonctionne pas, je n'ai que le dernier tableau copié. Que puis-je faire ?

[laetitia]

bonsoir juju05 le forum. dans ton cas un truc comme cela c'est peut être suffisant non?? COPY a la suite

Code :

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

1
2
3
4
Sub es()
 Sheets(2).Activate: Range([a1], ActiveCell.SpecialCells(xlLastCell)).Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
 Sheets(3).Activate: Range([a1], ActiveCell.SpecialCells(xlLastCell)).Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
End Sub

ou si tu tiens a une boucle!! mais pour seulement 2 feuilles ??

Code :

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

1
2
3
4
5
6
Sub Macro2()
   Dim ws As Worksheet
  For Each ws In Sheets(Array("feuil2", "feuil3"))
ws.Activate: Range([a1], ActiveCell.SpecialCells(xlLastCell)).Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
   Next ws
End Sub

[juju05]

J'ai simplifié ce que je voulai faire pour avoir une réponse sur le coller-tout.

En fait, j'ai un classeur avec X feuilles qui comprennent chacune 1 tableau de format différent. Je veux:

- récupérer l'ensemble de mes tableaux de mes différentes feuilles,

- coller l'ensemble de cette agrégation dans un autre classeur.

[laetitia]

re, le principe avec explications a adapter!!!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub es()
Dim dep, Dest As Workbook, Ws As Worksheet
   Set dep = Workbooks("classeur2") 'feuille classeur a copier
   Set Dest = Workbooks("classeur1") 'classeur destination
   Application.ScreenUpdating = False 'pas de mise a jour ecran plus rapide execution
   For Each Ws In dep.Worksheets 'boucle sur les feuilles du classeur 2
   If Ws.Name <> "Feuil4" And Ws.Name <> "Feuil5" Then 'sauf feuille 4 & 5
 dep.Sheets(Ws.Name).Activate 'active feuilles
 Range([a1], ActiveCell.SpecialCells(xlLastCell)).Copy Destination:=Dest.Sheets(1).Range("a65536").End(xlUp)(2)
        End If: Next Ws
    Set dep = Nothing: Set Dest = Nothing
    Windows("classeur1").Activate
 End Sub

[juju05]

Je suis désolé mais cela ne fonctionne pas. De plus je ne souhaiterai coller que les valeurs.

Je joins le fichier à remplir "Intégration heures boost.xls" et le fichier de départ "Matrice Louise.xls".

La macro s'active en cliquant sur le bouton Intégration.

Merci d'avance.

[laetitia]

re, en reprenant le debut de ton code je suppose que le code pour ouvrir le fichier Matrice Louise.xls fonctionne
cette ligne en debut de code sert a rien

Code :

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

Application.CutCopyMode = True

'debut de ton code variables puis chemin ect..
j'ai ajouter 2 variables

supprimer les lignes dont le montant est égal à 0

je pense que cela correspond a la colonne D nb...heures

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
Dim t As Variant
        Dim i As Long
        Set dep = Workbooks("Matrice Louise.xls")
        Set Dest = Workbooks("Intégration heures boost.xls")
       Application.ScreenUpdating = False
        For Each Ws In dep.Worksheets
       If Ws.Name <> "Fctnmt" Then
                  dep.Sheets(Ws.Name).Activate
            If Ws.Name = "Lavage Caisses" Then DATE_TRAITEE = CDate(Range("A2").Value)
            t = Range("A1", ActiveCell.SpecialCells(xlLastCell))
 Dest.Sheets(1).Range("A" & Dest.Sheets(1).Cells.Find("*", , , , , xlPrevious).Row + 1).Resize(UBound(t, 1), UBound(t, 2)) = t
       End If
     Next Ws
          Set dep = Nothing: Set Dest = Nothing
   Windows("Intégration heures boost.xls").Activate
For i = Range("b65536").End(xlUp).Row To 1 Step -1
   If Range("A" & i).Value = "" Then Range("A" & i).Value = DATE_TRAITEE
   If Range("D" & i).Value = 0 Or (Range("A" & i).Value = "Date" And Range("D" & i).Value <> "Heures") Then Rows(i).Delete
       Next i
MsgBox Timer - Heure