Copiez la CurrentRegion d’une cellule de chaque feuille dans une feuille à l’aide de VBA dans Microsoft Excel
Si vous gérez plusieurs feuilles à la fois et que vous souhaitez copier les données de chaque feuille dans une feuille de calcul principale, vous devez lire cet article. Nous utiliserons la propriété currentregion du code VBA pour consolider les données de toutes les feuilles de calcul dans une seule feuille. Cette propriété est utile pour de nombreuses opérations qui développent automatiquement la sélection pour inclure toute la région actuelle, comme la méthode AutoFormat. Cette propriété ne peut pas être utilisée sur une feuille de calcul protégée.
La condition est la suivante: chaque feuille doit contenir un format similaire, c’est-à-dire le même nombre de colonnes; en utilisant le même format, nous pouvons avoir des données fusionnées avec précision.
Remarque: cet article démontrera l’utilisation du code VBA; si, pour une raison quelconque, le nombre de colonnes diffère dans l’une des feuilles, toutes les données fusionnées ne donneront pas une image précise. Il est fortement recommandé d’utiliser le même nombre de colonnes. Le code VBA ajoutera une nouvelle feuille au classeur, puis copiera et collera les données après chaque feuille sans écraser.
Prenons un exemple de 3 feuilles, à savoir janvier, février et mars. Voici un aperçu de ces feuilles:
Pour combiner les données de toutes les feuilles en une seule feuille, nous devons suivre les étapes ci-dessous pour lancer l’éditeur VB:
Cliquez sur l’onglet Développeur Dans le groupe Code, sélectionnez Visual Basic
-
Copiez le code ci-dessous dans le module standard
Sub CopyCurrentRegion()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Range("A1").CurrentRegion.Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CopyCurrentRegionValues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
With sh.Range("A1").CurrentRegion
DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function
Si vous avez aimé nos blogs, partagez-les avec vos amis sur Facebook. Et vous pouvez aussi nous suivre sur Twitter et Facebook.
Nous serions ravis de vous entendre, faites-nous savoir comment nous pouvons améliorer, compléter ou innover notre travail et le rendre meilleur pour vous. Écrivez-nous à [email protected]