Sub test()
fin = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
For n = fin To 1 Step -1
If Feuil1.Range("A" & n) = "Volume (micron^3)" Then
Sheets.Add
Feuil1.Range("A" & n & ":A" & fin).Copy Destination:=ActiveSheet.Range("A1").Resize(fin - n + 1)
Feuil1.Range("A" & n & ":A" & fin) = ""
End If
Next
End Sub