Copier une ligne entière sur une autre feuille Si

Re,

cathie_mck a écrit :

Effectivement , ce serait super de pouvoir copier sur chaque feuille en A1 , Rapport Mensuel , en ligne A2 le nom du service selon G1 par exemple. Est ce qu'on pourrait définir la police , la couleur et souligné le nom du service (cellule A2) ? Et par la suite copier les lignes de titres des ligne 2, 3 et 4 du fichier suivi soumission à la suite en A3 du fichier Rapport?

Afin de répondre à ton attente ci-dessus, peux-tu éventuellement placer sur le forum une feuille correspondant au résultat désiré ?

cathie_mck a écrit :

Et derniere question,est ce que c'est possible de supprimer certaine colonne lors de la copie dans le fichier rapports, certaines des données n'ont pas besoin d'être connu , par exemple les colonnes X et W,ce n'est pas encore définitif que se sera celle-ci.

Si tu as besoin des informations de peu de colonnes, il vaudrait peut-^tre mieux ne copier et coller que les informations utiles. Par contre on pourrait reporter la ligne entière comme maintenant puis effacer les colonnes inutiles. Peux-tu éventuellement voir encore quelles colonnes pourraient ^tre effacées et je te rends réponse en m^me temps qu'à ton autre demande ci-dessus ?

A te relire.

Bonjour,

Voici un exemple de ce que j'aimerais , toujours en fonction du dernier code proposé.

Les colonnes qui devrait etre supprimer sont X , Y et Z .

J'aimerais qu'on conserve le derneir code en ce qui concerne la copie complète des ligne. J'aimerais qu'une fois la copie effectuée, les colonnes inutiles dans ce fichiers ( X, Y et Z) soit supprimer pas la suite.

Voilà ,

Au plaisirs,,,

Cathie

Salut Cathie,

Je te propose que l'on place une feuille modèle dans ton fichier de base qui s'appellerait "Rapport Mensuel", comme dans le fichier ci-joint. Cette feuille contient déjà la formule désirée en B2.

En lançant le nouveau code proposé, une nouvelle feuille par "Service requérant" est créée dans un nouveau fichier et toutes les feuilles inutiles sont effacées.

Avec le nouveau code mis en place, la dernière feuille sélectionnée est visible à l'écran en fin de macro et - s'il y a beaucoup d'onglets car il y a beaucoup de "Services requérants" - les premiers onglets ne seront pas visibles en bas à gauche***. Je ne sais pas comment faire autrement. Est-ce gênant ? Si oui, on pourrait demander de l'aide sur le forum afin que la première feuille créée soit visible à l'écran (mais il y aurait toujours le problème que les derniers onglets seraient éventuellement cachés vers la droite).

***EDIT 2: Il suftit bien entendu, dans un tel cas, de faire défiler les onglets à l'aide des flèches à gauche des onglets afin de pouvoir acceder à n'importe lequel d'entre eux.

A te relire.

EDIT : fichier retiré à la demande de Cathie pour cause de confidentialité. En remplacement, le dernier code proposé.

Sub Transfert()

Dim DerLig As Integer, Nouveau_fichier As String, Référence As String, Référence_bis As String
Dim i As Integer, j As Integer, Feuille As Worksheet

Application.ScreenUpdating = False
Application.Dialogs(xlDialogSaveAs).Show 'création d'un nouveau fichier
Application.DisplayAlerts = False

Nouveau_fichier = ActiveWorkbook.Name

'Suppression des feuilles existantes mais inutiles
For Each Feuille In ActiveWorkbook.Worksheets
    If Feuille.Name <> "Soumissions_2011" And Feuille.Name <> "Rapport Mensuel" Then
        Feuille.Delete
    End If
Next Feuille

Sheets("Soumissions_2011").Activate

'Création de toutes feuilles utiles moins celle pour les lignes sans référence
For j = 323 To 340
    Référence_bis = Cells(j, 79)
    Sheets("Rapport Mensuel").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Référence_bis
    Range("F1") = Date
    Columns("X:Z").Delete Shift:=xlToLeft
    Sheets("Soumissions_2011").Activate
Next

' Une feuille de plus pour les lignes sans référence dans colonne G
Sheets("Rapport Mensuel").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sans référence"
Range("F1") = Date
Columns("X:Z").Delete Shift:=xlToLeft
Sheets("Soumissions_2011").Activate

'Report des données sans référence
Range("A7").Activate
Do While ActiveCell <> ""
    If ActiveCell.Offset(0, 6) = "" Then
        Range(ActiveCell, ActiveCell.Offset(0, 46)).Copy
        Sheets("Sans référence").Activate
        DerLig = ActiveSheet.Range("A65536").End(xlUp).Row
        If DerLig = 3 Then
            Range("A6").Activate
        Else
            Range("A" & DerLig + 1).Activate
        End If
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Sheets("Soumissions_2011").Activate
     End If
     ActiveCell.Offset(1, 0).Activate
Loop

'Report des données avec référence
Range("A7").Activate
For j = 323 To 340
    Référence = Cells(j, 7)
    Référence_bis = Cells(j, 79)

    Do While ActiveCell <> ""
        If ActiveCell.Offset(0, 6) = Référence Then
            Range(ActiveCell, ActiveCell.Offset(0, 46)).Copy
            Sheets(Référence_bis).Activate
            DerLig = ActiveSheet.Range("A65536").End(xlUp).Row
            If DerLig = 3 Then
                Range("A6").Activate
            Else
                Range("A" & DerLig + 1).Activate
            End If
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Sheets("Soumissions_2011").Activate
         End If
         ActiveCell.Offset(1, 0).Activate
    Loop
    Range("A7").Activate
Next

'Effacement des feuilles du fichier de base et des feuilles nouvellement créées mais sans données.
For Each Feuille In ActiveWorkbook.Worksheets
    If Feuille.Range("A6") = "" Then
        Feuille.Delete
    Else
        Feuille.Activate
        DerLig = Range("A65536").End(xlUp).Row
        Range("A" & DerLig + 1).Activate
    End If
Next Feuille

ActiveWorkbook.Save
End Sub

Désolé, mais mon code est incorrect : il faut bien entendu supprimer les colonnes X, Y et Z après l'importation des données. Voici le code corrigé

Sub Transfert()

Dim DerLig As Integer, Nouveau_fichier As String, Référence As String, Référence_bis As String
Dim i As Integer, j As Integer, Feuille As Worksheet

Application.ScreenUpdating = False
Application.Dialogs(xlDialogSaveAs).Show 'création d'un nouveau fichier
Application.DisplayAlerts = False

Nouveau_fichier = ActiveWorkbook.Name

'Suppression des feuilles existantes mais inutiles
For Each Feuille In ActiveWorkbook.Worksheets
    If Feuille.Name <> "Soumissions_2011" And Feuille.Name <> "Rapport Mensuel" Then
        Feuille.Delete
    End If
Next Feuille

Sheets("Soumissions_2011").Activate

'Création de toutes feuilles utiles moins celle pour les lignes sans référence
For j = 323 To 340
    Référence_bis = Cells(j, 79)
    Sheets("Rapport Mensuel").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Référence_bis
    Range("F1") = Date
    Sheets("Soumissions_2011").Activate
Next

' Une feuille de plus pour les lignes sans référence dans colonne G
Sheets("Rapport Mensuel").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sans référence"
Range("F1") = Date
Sheets("Soumissions_2011").Activate

'Report des données sans référence
Range("A7").Activate
Do While ActiveCell <> ""
    If ActiveCell.Offset(0, 6) = "" Then
        Range(ActiveCell, ActiveCell.Offset(0, 46)).Copy
        Sheets("Sans référence").Activate
        DerLig = ActiveSheet.Range("A65536").End(xlUp).Row
        If DerLig = 3 Then
            Range("A6").Activate
        Else
            Range("A" & DerLig + 1).Activate
        End If
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Sheets("Soumissions_2011").Activate
     End If
     ActiveCell.Offset(1, 0).Activate
Loop

'Report des données avec référence
Range("A7").Activate
For j = 323 To 340
    Référence = Cells(j, 7)
    Référence_bis = Cells(j, 79)

    Do While ActiveCell <> ""
        If ActiveCell.Offset(0, 6) = Référence Then
            Range(ActiveCell, ActiveCell.Offset(0, 46)).Copy
            Sheets(Référence_bis).Activate
            DerLig = ActiveSheet.Range("A65536").End(xlUp).Row
            If DerLig = 3 Then
                Range("A6").Activate
            Else
                Range("A" & DerLig + 1).Activate
            End If
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Sheets("Soumissions_2011").Activate
         End If
         ActiveCell.Offset(1, 0).Activate
    Loop
    Range("A7").Activate
Next

'Effacement des feuilles du fichier de base et des feuilles nouvellement créées mais sans données.
For Each Feuille In ActiveWorkbook.Worksheets
    If Feuille.Range("A6") = "" Then
        Feuille.Delete
    Else
        Feuille.Activate
        Columns("X:Z").Delete Shift:=xlToLeft
        DerLig = Range("A65536").End(xlUp).Row
        Range("A" & DerLig + 1).Activate
    End If
Next Feuille

ActiveWorkbook.Save
End Sub

A te relire.

Bonsoir , le code fonctionne très bien !!!

Ce code est terminé et la hauteur de mes attentes,

Une derniere question concernant cette partie du code,

    Else
        Feuille.Activate
        Columns("X:Z").Delete Shift:=xlToLeft

Comment est ce que je pourrais choisir les colonne B et F et de X à Z a supprimer ?

Comme certaine ne se suivent pas , je suis un peu embêté.

Merci pour ta collaboration dans ce dossier , merci pour ta patience et le partage de tes connaissances.

Salut Cathie, longtemps plus vue

Je crois que tu ne peux pas indiquer des références à plusieurs plages avec l'expression Columns.

Utilise donc par l'expression Range

    Else
        Feuille.Activate
        Range("B:B,F:F,X:Z").Delete Shift:=xlToLeft 

A te relire

Bon Matin Yvouille,

Le tout fonctionne parfaitement et à la hauteur de mes attentes, je peux donc dire ce matin , Mission réussie!!!!

Merci pour ton aide précieuse!!!

Je vais donc fermer le post !!! Je reviendrai eventuellement avec un autre projet !!!

Au plaisir,

Cathie

Bon vent