Fusionner des feuilles dans une fiche maître

Question

J'ai récupéré le code suivant sur le site de Ron de Bruin et cela fonctionne très bien pour extraire des données dans une feuille principale et mettre à jour la feuille principale chaque fois que des modifications sont apportées aux autres feuilles.

Mais je voudrais copier seulement certaines colonnes de données. Par exemple mes feuilles ont des données de A:Z mais j'ai seulement besoin des données A:P dans ma feuille principale.

Toute aide à ce sujet sera grandement appréciée et s'il vous plaît sachez que je suis un non-codeur, alors s'il vous plaît être précis sur ce qu'il faut changer et où le changer.

Sub CopyDataWithoutHeaders() 
Dim sh As Worksheet 
Dim DestSh As Worksheet 
Dim Last As Long 
Dim shLast As Long 
Dim CopyRng As Range 
Dim StartRow As Long 

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

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

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

'Fill in the start row 
StartRow = 2 

'loop through all worksheets and copy the data to the DestSh 
For Each sh In ActiveWorkbook.Worksheets 
    If sh.Name <> DestSh.Name Then 
    'Copy header row, change the range if you use more columns 
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then 
    sh.Range("A1:Z1").Copy DestSh.Range("A1") 
End If 

     'Find the last row with data on the DestSh and sh 
     Last = LastRow(DestSh) 
     shLast = LastRow(sh) 

     'If sh is not empty and if the last row >= StartRow copy the CopyRng 
     If shLast > 0 And shLast >= StartRow Then 

      'Set the range that you want to copy 
      Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) 
      '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 below example 1 on this page 
      CopyRng.Copy 
      With DestSh.Cells(Last + 1, "A") 
       .PasteSpecial xlPasteValues 
       .PasteSpecial xlPasteFormats 
       Application.CutCopyMode = False 
      End With 

     End If 

    End If 
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 
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 

Answer 1

En fait, il suffit de changer le code qui définit la zone à copier. Dans votre cas, vous devez vérifier les « gammes » avant de copier les données:

sh.Range("A1:Z1").Copy DestSh.Range("A1") 

Cette ligne prend soin des titres, de sorte que vous pouvez remplacer le Z1 avec e. g. P1.

La gamme suivante consiste à copier les données:

Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) 

Ici, vous pouvez utiliser les fonctionnalités existantes pour obtenir la ligne de départ correcte et dernière ligne. Mais au lieu de sélectionner les lignes complètes vous suffit de sélectionner une partie de la feuille:

sh.Range("A" & StartRow & ":P" & shLast) 

Cela devrait faire l'affaire.

P.S. Même si vous n'êtes pas un programmeur. Jetez un oeil à la base de VBA, ce n'est pas si difficile et vous pouvez faire beaucoup de choses intéressantes si vous savez comment cela fonctionne ... :)