[Copier/Coller certaines lignes d'une colonne]

Bonjour à tous,

Je souhaiterai copier/coller certaines lignes de ma seconde feuille de calcul sur la première.

Plus précisément, je souhaite copier les lignes, qui vont de la ligne contenant le terme "Balance Sheet" à celle contenant le terme "Summary Analytics" de la deuxième colonne de la feuille 2 de mon fichier Excel et coller ces dites lignes sur les premières colonnes de la première ligne de ma feuille1.

Or, je n'arrive pas à réaliser un programme fonctionnel VBA.

Je vous ai joint ci-dessous le fichier sur lequel je travaille.

Voici mon programme, qui ne fonctionne pas :

Sub Balance()

For i = 1 To 1000 
 If Cells(i + 115, 2) = "Balance Sheet" Then '115 vient du fait que "Balance Sheet" est écrit dans une autre cellule précédente à la 115ème
  Do
   For j = i To 300 '300 vient du fait que je sais que ma condition sera vérifiée au bout d'au moins 300 cellules
   Feuil1.Cells(1, k + 1) = Feuil2.Cells(j + 115, 2)
   k = k + 1
   Next
  Loop Until Feuil2.Cells(j + 115, 2) = "Summary Analytics"
 End If
Next

End Sub

Merci d'avance,

Etrof

17test.xlsx (29.09 Ko)

Bonjour,

ci-joint code

Sub balance()

    Dim colB_utilisée, cellule, plage_lignes  As Range

    'définition colonne B utilisée de Feuil2
    Set colB_utilisée = Range(Feuil2.[B1], Feuil2.[B:B].Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious))
    'recherche des cellules "Balance Sheet" et "Summary Analytics"
    For Each cellule In colB_utilisée.Cells
        If Trim(cellule.Value) = "Balance Sheet" Then Set cellule1 = cellule
        If Trim(cellule.Value) = "Summary Analytics" Then Set cellule2 = cellule
    Next

    ' définition plage colonne B de Feuil2 à transposer
    Set plage_lignes = Range(cellule1, cellule2)

    ' transposition sur la ligne 1 de Feuil1
    Feuil1.Rows(1).Value = Application.Transpose(plage_lignes.Value)

End Sub

Bonjour à tous,

Tout d'abord, je te remercie Thev pour ta réponse.

Finalement, je souhaite un programme un peu plus complexe.

Je pensais réussir à le réaliser suite à ta réponse mais en vain...

Je souhaite faire la manipulation précédente de la feuille 2 sur la feuille 1, 50 fois.

Je m'explique : j'ai 50 feuilles du même type que la feuille 2 et sur la feuille 51 (vierge), je souhaiterai faire copier, ce qui m'intéresse (précédemment décrit), sur la ième feuille, et le coller sur la ième colonne de la feuille51.

J'ai essayé avec une boucle for comme ci-dessous :

Sub balance()

    Dim colB_utilisée, cellule, plage_lignes  As Range
    Dim i As Integer

   For i = 1 To 50
    'définition colonne B utilisée de Feuili
   Set colB_utilisée = Range(Feuili.[B1], Feuili.[B:B].Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious))
    'recherche des cellules "Balance Sheet" et "Summary Analytics"
   For Each cellule In colB_utilisée.Cells
        If Trim(cellule.Value) = "Balance Sheet" Then Set cellule1 = cellule
        If Trim(cellule.Value) = "Summary Analytics" Then Set cellule2 = cellule
    Next

    ' définition plage colonne B de Feuili à transposer
   Set plage_lignes = Range(cellule1, cellule2)

    ' transposition sur la ligne i de Feuil51
   Feuil51.Rows(i).Value = Application.Transpose(plage_lignes.Value)
Next

End Sub

Mais, VBA me répond comme message d'erreur "Erreur d'exécution '424' Objet requis".

Auriez-vous une solution ? Voici le fichier de base sur lequel je travaille https://www.fichier-xls.fr/2016/06/29/test-prog/

Merci d'avance

Etrof

Ci- dessous nouveau code selon votre demande.

Je dois cependant vous avertir que les nouvelles feuilles ajoutées dans votre classeur ne sont pas cohérentes avec un classeur Excel 2007 (*.xls) et provoquent des erreurs dans le code. Ces feuilles proviennent à mon avis d'un classeur Excel ultérieur (*.xlsx).

En mettant le tout dans un classeur Excel 2010 ou supérieur (*.xlsm), le code fonctionne parfaitement.

Sub balance()

    Dim feuille As Worksheet
    Dim colB_utilisée, cellule, plage_lignes  As Range

    On Error Resume Next   'activation gestion routine d'erreurs
    For Each feuille In ThisWorkbook.Worksheets

        If feuille.CodeName <> "Feuil51" Then

            'définition colonne B utilisée de la feuille
            Set colB_utilisée = Range(feuille.[B1], feuille.[B:B].Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious))
            'recherche des cellules "Balance Sheet" et "Summary Analytics"
            For Each cellule In colB_utilisée.Cells
                 If Trim(cellule.Value) = "Balance Sheet" Then Set cellule1 = cellule
                 If Trim(cellule.Value) = "Summary Analytics" Then Set cellule2 = cellule
            Next
            ' définition plage colonne B de Feuil2 à transposer
            Set plage_lignes = Range(cellule1, cellule2)

            ' transposition sur la ligne i de Feuil1
            Feuil51.Rows(feuille.Index).Value = Application.Transpose(plage_lignes.Value)

        End If

        ' détection éventuelle d'erreur
        If Err.Number <> 0 Then
            MsgBox Err.Description
            Err.Clear
        End If

    Next
Rechercher des sujets similaires à "copier coller certaines lignes colonne"