Dans cet article, nous allons créer une macro pour copier les données de toutes les feuilles du classeur vers une nouvelle feuille.

Les données brutes pour cet exemple se composent des détails des employés de différents services dans différentes feuilles. Nous souhaitons regrouper les détails des employés dans une seule feuille.

ArrowRawData

Nous avons créé une macro «CopyRangeFromMultipleSheets» pour la consolidation des données. Cette macro peut être exécutée en cliquant sur le bouton «Consolider les données».

ArrowMain

Macro créera une nouvelle feuille de calcul et insérera les données consolidées de toutes les feuilles de calcul.

ArrowOutput

Explication du code

« Boucle » sur toutes les feuilles pour vérifier si la feuille « Master » existe.

Pour chaque source dans ThisWorkbook.Worksheets Si Source.Name = « Master » Alors MsgBox « La feuille maître existe déjà »

Exit Sub End If Next Above code est utilisé pour vérifier si la feuille «Master» existe dans le classeur. Si la feuille «principale» existe dans le classeur, le code se ferme et un message d’erreur s’affiche.

Source.Range (« A1 »). SpecialCells (xlLastCell) .Row Le code ci-dessus est utilisé pour obtenir le numéro de ligne de la dernière cellule de la feuille.

Source.Range (« A1 », Range (« A1 »). SpecialCells (xlLastCell)). Copier Destination.Range (« A » & DestLastRow)

Le code ci-dessus est utilisé pour copier la plage spécifiée dans la cellule définie.

Veuillez suivre ci-dessous pour le code

Sub CopyRangeFromMultipleSheets()

'Declaring variables

Dim Source As Worksheet

Dim Destination As Worksheet

Dim SourceLastRow, DestLastRow As Long

Application.ScreenUpdating = False

'Looping through all sheets to check whether "Master" sheet exist

For Each Source In ThisWorkbook.Worksheets

If Source.Name = "Master" Then

MsgBox "Master sheet already exist"

Exit Sub

End If

Next

'Inserting a new sheet after the "Main" sheet

Set Destination = Worksheets.Add(after:=Sheets("Main"))

Destination.Name = "Master"

'Looping through all the sheets in the workbook

For Each Source In ThisWorkbook.Worksheets



'Preventing consolidation of data from "Main" and "Master" sheet

If Source.Name <> "Main" And Source.Name <> "Master" Then



SourceLastRow = Source.Range("A1").SpecialCells(xlLastCell).Row



Source.Activate



If Source.UsedRange.Count > 1 Then



DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row



If DestLastRow = 1 Then

'copying data from the source sheet to destination sheet

Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow)

Else

Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1))

End If



End If

End If

Next

Destination.Activate

Application.ScreenUpdating = True

End Sub

Si vous avez aimé ce blog, partagez-le avec vos amis sur Facebook et Facebook.

Nous aimerions avoir de vos nouvelles, faites-nous savoir comment nous pouvons améliorer notre travail et le rendre meilleur pour vous. Écrivez-nous à [email protected]