Excel 2007 Macro VBA from Ron de Bruin.

QcSylvanio

XLDnaute Nouveau
Bonjour à tous,

J'espère que tout le monde va bien. Je suis nouveau sur le forum. Je m'appelle Sylvain Bittner, j'ai 26ans. Je débute en VBA sous excel. Je connais bien excel mais voila que je dois apprendre la base pour les macro pour mon travail.

J'aimerais obtenir de l'aide sur une macro qui provient de Ron de Bruin ( Merge cells from all or some worksheets into one Master sheet ). J'essaie d'adapter cette macro depuis 3 jours et j'ai besoin d'un petit coup de main.

Donc, ce que je veux faire :
Je veux copier 3 onglets entier dans un nouvel onglet. (Ce que la macro me permet de faire actuellement).
J'aimerais cependant ajouter une condition (exemple si R = "BLABLA" alors ne pas copier la ligne) mais je n'y arrive pas.

Code:
Sub CopyData()
    
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim startrow As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "RDBMergeSheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "RDBMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    'Loop through those worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Sheets(Array("MonTitre1", "MonTitre2", "MonTitre3"))

            'Find the last row with data on the DestSh
            Last = Lastrow(DestSh)

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("B:C, N:S, V:V, AC:AC, AH:AH, AI:AV")
            
            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
               ' .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

    
    Next
    
ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub


J'aimerais également savoir pourquoi la fonction :
Code:
'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

Je ne comprend pas pourquoi j'obtient le message d'erreur car je n'ai pas atteint le maximum de ligne d'Excel 2007.

Et pour finir, un petit détail dont je j'arrive pas à trouver la réponse sur le forum. J'aimerais savoir comment référer au texte d'une cellule qui se tient sur 2 lignes? R = "BLA bla" mais ou le bla est sur une deuxième ligne.


Je vous remercie d'avance pour votre aide!
 

Efgé

XLDnaute Barbatruc
Re : Excel 2007 Macro VBA from Ron de Bruin.

Bonjour QcSylvanio et bienvenu sur le forum
Comme tu as lu Lien supprimé, tu sais à quel point un fichier exemple est utile pour ceux qui tentent de répondre....:rolleyes:
Juste des idées sur tes questions:
Pour
J'aimerais cependant ajouter une condition (exemple si R = "BLABLA" alors ne pas copier la ligne)
Suivant le nombre de lignes présentent sur tes onglets à copier, il serait peut être préférable de supprimer les lignes inutiles après l'importation.
Pour
Je ne comprend pas pourquoi j'obtient le message d'erreur car je n'ai pas atteint le maximum de ligne d'Excel 2007.
Si tu utilise une plage qui s'étend sur des colonnes entières comme:
Code:
Set CopyRng = sh.Range("B:C, N:S, V:V, AC:AC, AH:AH, AI:AV")
La ligne
Code:
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
renvera toujours True (sauf à ce que Last = 0)
Enfin ce ne sont que des idées sans exemple sur lequel s'appuyer...
Bon courage
Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
311 719
Messages
2 081 881
Membres
101 829
dernier inscrit
listener75