Discussion :

[maxeln]

Bonjour

J'ai une macro qui est pratiquement terminée. Elle me copie une ligne d'une feuille "RECAP" vers une autre FEUIL3 mais dans le même classeur. Je n'arrive pas à faire en sorte de l'extraire vers une feuille d'un autre classeur

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub RDB()
'
' RDB Macro
 
Dim Cel As Range
Application.ScreenUpdating = False
With Sheets("Recap")
     For Each Cell In .Range(.[A7], .[AL65536].End(xlUp))
          If Cell = "RDB" Then .Rows(Cell.Row).Copy Sheets("Feuil3").Rows(Sheets("Feuil3").[AL65536].End(xlUp).Row + 1)
     Next
Application.ScreenUpdating = True
End With
End Sub

Merci pour votre aide

[Invité]

Bonjour,

A adapter :
A noter que le code fonctionne également sur un onglet du même classeur.

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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
Option Explicit
 
Sub Rdb_AvecAutreClasseur(ByVal AireSource As Range, ByVal FeuilleCible As Worksheet)
 
Dim CelluleSource As Range
Dim LigneCible As Long
 
    With FeuilleCible
         LigneCible = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
         Debug.Print LigneCible
    End With
 
    For Each CelluleSource In AireSource
        If CelluleSource = "RDB" Then
           CelluleSource.EntireRow.Copy FeuilleCible.Cells(LigneCible, 1)
           LigneCible = LigneCible + 1
        End If
    Next CelluleSource
 
End Sub
 
Sub CopierDansUnAutreClasseur()
 
Dim ShSource As Worksheet, ShCible As Worksheet
Dim DerniereLigneSource As Long
 
    Set ShSource = Workbooks("Copie lignes dans nouveau fichier 2017-09-30.xlsm").Sheets("Recap") ' A adapter
    Set ShCible = Workbooks("ClasseurCible.xlsm").Sheets("Feuil1")                                ' A adapter
 
    With ShSource
            DerniereLigneSource = .Cells(.Rows.Count, "AL").End(xlUp).Row
            Application.ScreenUpdating = False
            Rdb_AvecAutreClasseur .Range(.Cells(7, 1), .Cells(DerniereLigneSource, "AL")), ShCible
            Application.ScreenUpdating = True
    End With
 
    Set ShSource = Nothing
    Set ShCible = Nothing
 
End Sub

[maxeln]

merci bcp, c'est exactement ce que je cherche
bonne journée