Transfert de données un peu spéciale ...

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
 
With Sheets("INDEX") 'prend en compte l'onglet "INDEX"
    For Each cel In .Range("B6:B" & .Range("B65536").End(xlUp).Row) 'boucle sur toutes les cellules éditées de la colonne B
        If cel.Value <> "" Then 'condition : si la cellule n'est pas vide
            Set dest = Sheets("BASE").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
            Range(cel, cel.Offset(0, 8)).Copy dest 'copie et colle
        End If 'fin de la condition
    Next cel 'prochaine cellule de la boucle
End With 'fin de la prise en compte de l'onglet "INDEX"
End Sub

Sub transfert()
Dim lastrow As Long

Application.ScreenUpdating = False


For i = 6 To 31 '--- parcours de toutes les lignes
    Sheets("INDEX").Activate '---sélection de la feuille INDEX
   If ActiveSheet.Cells(i, 2).Value <> "" Then '--- test si ligne vide
        ActiveSheet.Range(Cells(i, 2), Cells(i, 10)).Copy
        Sheets("BASE").Activate
        On Error Resume Next
        lastrow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row '---détection dernière ligne occupée sur BASE
        ActiveSheet.Cells(lastrow + 1, 1).Select
        ActiveSheet.Paste
    End If
Next i

Application.ScreenUpdating = True
End Sub