Copie cellules sous condition

Le 12/10/2020 à 20:59

Bonjour

J'ai trouvé plein de VBA pour copier des lignes d'une feuille à l'autre sous condition, mais comment copier des des éléments lignes, à savoir seulement C, AG, AH, AI, AJ, AK, si AG contient un mot spécifique ?

Merci de votre aide

Le 12/10/2020 à 21:10

Hello,

par exemple :

if range("C1").value = "toto" then rows(1).copy
if range("C1").value = "toto" and range("E1") = "tata" then rows(1).copy

R@g

Le 12/10/2020 à 21:28

mais comment copier des des éléments lignes, à savoir seulement C, AG, AH, AI, AJ, AK, si AG contient un mot spécifique

Merci de ta réponse, mais dans ta formule, si la cellule C contient le mot "toto", alors la ligne est copiée, or je ne veux que des parties de celle ci

Le 12/10/2020 à 23:30

Bonjour,

Voici une solution mais à adpater avec le besoin :

Sub CopierPartie()

Dim Colspec as range, plage as range
Dim ligne%

Set Colspec = Range("C:C, AG:AK")

ligne = 1 'à adapter (pas d'info, pas de fichier)
Set plage = intersect(Colspec, rows(ligne))

if range("AG" & ligne).value = "toto" then
    plage.copy destination:=range("A" & ligne + 1) 'exemple à adpater (pas d'info)
end if
    
End sub

Cdlt,

Le 13/10/2020 à 21:11

Merci beaucoup, je m'y attèle demain.

Le 14/10/2020 à 07:41

Donc, pour copier de la feuille "effectif" à "bus", sachant que les lignes débutent sur la seconde ligne :

Dim Colspec As Range, plage As Range
Dim ligne%

Set Colspec = Range("C:C, AG:AK")

ligne = 1 to 67 'à adapter 
Set plage = Intersect(Colspec, Rows(ligne))

If Range("AG" & ligne).Value = "mensuel" Then
    plage.Copy Destination:=Sheets("Bus").Range("A" & ligne + 1) 
End If

Est ce juste ?

Le 14/10/2020 à 07:58

Bonjour,

Pas exactement mais tu en étais proche. Il fallait faire une boucle et mettre la condition au sein de cette boucle. Voici un essai :

Sub CopierCondition()

Dim Colspec As Range, plage As Range
Dim i%

With Sheets("effectif")
    Set Colspec = .Range("C:C, AG:AK") 'colonnes voulues
    for i = 1 to 67 'pour les lignes de 1 à 67
        If .Range("AG" & i).Value = "mensuel" Then 'si AG = "mensuel"
            if plage is nothing then 'si la plage à copier est vide
                set plage = Intersect(Colspec, .Rows(i)) 'initialisation de cette plage
            Else 'sinon
                Set plage = Union(plage, Intersect(Colspec, .Rows(i))) 'la plage annexe les nouvelles cellules (ligne en cours)
            end if
        End If
    next i
End with

plage.Copy Destination:=Sheets("Bus").Range("A" & 2)  'copie de la plage effectif dans la feuille Bus en A2

End sub

Cdlt,

Le 14/10/2020 à 21:33

Bonjour,

Si ça ne marche pas, essayez comme ceci :

Sub CopierCondition()

Dim plage As Range
Dim i%

With Sheets("effectif")
    for i = 1 to 67 'pour les lignes de 1 à 67
        If .Range("AG" & i).Value = "mensuel" Then 'si AG = "mensuel"
            if plage is nothing then 'si la plage à copier est vide
                set plage = .Range("C" & i &", AG" & i & ":AK" & i) 'initialisation de cette plage
            Else 'sinon
                Set plage = Union(plage, .Range("C" & i &", AG" & i & ":AK" & i)) 'la plage annexe les nouvelles cellules (ligne en cours)
            end if
        End If
    next i
End with

plage.Copy Destination:=Sheets("Bus").Range("A" & 2)  'copie de la plage effectif dans la feuille Bus en A2

End sub

Cdlt,

Le 14/10/2020 à 22:11

Du coup, j'ai utilisé les deux.

Toutefois, il y a la même erreur de type 91 pour :

plage.Copy Destination:=Sheets("Bus").Range("A" & 2)
Le 14/10/2020 à 22:38

Est-ce que la feuille Bus existe ?

Edit : Excuse-moi, il faut saisir la ligne ainsi :

plage.Copy Destination:=Sheets("Bus").Range("A2")

C'est le "A" & i que je n'ai pas bien corrigé...

Le 17/10/2020 à 16:42

La feuille Bus existe bien.

Il m'est renvoyé une erreur 91 avec variable objet ou de bloc non définie avec with erreur 91 :

plage.Copy Destination:=Sheets("Bus").Range("A2")
Sub Lettrebus()

Dim Msg As String, Style, Title As String, Default As String, Choix As String
'Message de contrôle de volonté d'imprimer
Msg = " Choix du bon :" & Chr(10) _
& "       " & Chr(10) _
& "Pour imprimer un bon avec abonnement mensuel et trimestriel : saisir 1" & Chr(10) _
& "       " & Chr(10) _
& "Pour imprimer un bon avec abonnement mensuel : saisir 2" & Chr(10) _
& "       " & Chr(10) _
& "Pour imprimer des bons individuels : saisir 3" & Chr(10) _
& "       " & Chr(10) _

    Title = "Choix du bon"    ' Définit le titre.
    Default = "Ex:1"    ' Défini une valeur exemple ' Affiche le message, le titre et la valeur par défaut.
    Choix = InputBox(Msg, Title, Default) ' Valeur de la variable.

If Choix = "" Or Choix = "Ex:1" Then Exit Sub
'Transfert des données saisies dans la feuille excés de vitesse

If Choix = 1 Then
Call Bonbusmensueltrimestriel

ElseIf Choix = 2 Then
Call Bonbusmensuel

ElseIf Choix = 3 Then
Call Publipostagebus

End If

End Sub

Sub Bonbusmensuel()

Dim Colspec As Range, plage As Range
Dim i%

With Sheets("effectif")
    Set Colspec = .Range("C:C, AG:AK") 'colonnes voulues
    For i = 1 To 67 'pour les lignes de 1 à 67
        If .Range("AG" & i).Value = "mensuel" Then 'si AG = "mensuel"
            If plage Is Nothing Then 'si la plage à copier est vide
                Set plage = Intersect(Colspec, .Rows(i)) 'initialisation de cette plage
            Else 'sinon
                Set plage = Union(plage, Intersect(Colspec, .Rows(i))) 'la plage annexe les nouvelles cellules (ligne en cours)
            End If
        End If
    Next i
End With

plage.Copy Destination:=Sheets("Bus").Range("A2")   'copie de la plage effectif dans la feuille Bus en A2

End Sub

Sub Bonbusmensueltrimestriel()

Dim plage As Range
Dim i%

With Sheets("effectif")
    For i = 1 To 67 'pour les lignes de 1 à 67
        If .Range("AG" & i).Value = "Mensuel" Or Range("AG" & i).Value = "Trimestriel" Then 'si AG = "mensuel"
            If plage Is Nothing Then 'si la plage à copier est vide
                Set plage = .Range("C" & i & ", AG" & i & ":AK" & i) 'initialisation de cette plage
            Else 'sinon
                Set plage = Union(plage, .Range("C" & i & ", AG" & i & ":AK" & i)) 'la plage annexe les nouvelles cellules (ligne en cours)
            End If
        End If
    Next i
End With

plage.Copy Destination:=Sheets("Bus").Range("A2")  'copie de la plage effectif dans la feuille Bus en A2

End Sub

Sub Publipostagebus()
'
' Lettrebus Macro
'
Dim Rep As Integer
Dim objDoc
Dim source$
Application.ScreenUpdating = False

NomBase = ThisWorkbook.Path & "\sourcepublipostage.xlsx"
DocWord = ThisWorkbook.Path & "\Bon renouvellement bus.docx"

With Sheets("Effectif") ' 'indiquer la feuille
    .Range(Cells(2, "AM"), Cells(.Cells(Rows.Count, "AL").End(xlUp).Row, "AM")) = Format(Now, "dd.m.yyyy")
    .Copy
End With
'sauvegarde du fichier source du publipostage
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NomBase, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close (True)

'publipostage
'ouverture du fichier modele
Set wordapp = CreateObject("word.Application")
wordapp.Visible = True
Set objDoc = wordapp.Documents.Open(DocWord)

With objDoc.MailMerge
        'connexion a la source
        .OpenDataSource Name:=NomBase, Connection:="Driver={Microsoft Excel Driver (*.xlsx)};" & "DBQ=" & NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Effectif$]"
        'destination du publipostage pour test nouveau doc sinon mettre wdSendToPrinter
        .Destination = wdSendToNewDocument 'wdSendToPrinter 'fusion vers l'imprimante
        .suppressBlankLines = True
        .DataSource.FirstRecord = 2
        .Execute Pause:=False 'Exécute l'opération de publipostage
End With
objDoc.Close (False)
End Sub
'
Le 17/10/2020 à 20:43

Bonjour,

Je pense alors que c'est parce que votre plage est vide. C'est-à-dire qu'elle n'a jamais été initialisée, faute de correspondance en AG.

Essayez ceci :

Sub CopierCondition()

Dim plage As Range
Dim i%

With Sheets("effectif")
    for i = 1 to 67 'pour les lignes de 1 à 67
        If .Range("AG" & i).Value = "mensuel" Then 'si AG = "mensuel"
            if plage is nothing then 'si la plage à copier est vide
                set plage = .Range("C" & i &", AG" & i & ":AK" & i) 'initialisation de cette plage
            Else 'sinon
                Set plage = Union(plage, .Range("C" & i &", AG" & i & ":AK" & i)) 'la plage annexe les nouvelles cellules (ligne en cours)
            end if
        End If
    next i
End with

if plage is nothing then msgbox "Aucune correspondance": Exit Sub

with Sheets("Bus")
    plage.Copy Destination:=.cells(.rows.count, 1).end(xlup).offset(1, 0)  'copie plage dans la feuille Bus en premiere cellule vide de A
end with

End sub

Cdlt,

Edit : en regardant ton second commentaire, je pense avoir compris. Il faut probablement remplacer "mensuel" par "Mois" !

Le 17/10/2020 à 21:30

Merci beaucoup, c'était tout bête mais oui, le terme était mauvais.

Rechercher des sujets similaires à "copie condition"