Composicion de Codigo

[JoaoM]

Este me salio de la grabadora, yo solo le agregue las demas hojas
Quisiera tener este codigo unificado(optimisado) lo mas posible para no ser tan largo.
Así me trabaja perfecto pero es largo y yo no se como hacerlo para un codigo que abarque)unifique) todas las hojas y todos los rangos. Si fuera una sola hoja, yo sabria como hacerlo pero así ya no llega a mis conocimientos. La linea

Código:

Range("C6").Activate

tuve que agregarla porque EN TODAS HOJAS me quedaban todos los rangos activados

Edito:
Me quedo atras el codigo:

Código:

Sub BorraContenido()
Application.ScreenUpdating = False
    Sheets("Preguntas No.1-2").Select 'Nombre de Hoja
        Range("C6:F50,I6:L50").Select 'Seleccion a borrar
        Selection.ClearContents 'Borra
            Range("C6").Select 'Desactiva y seleciona celda C6
        
    Sheets("Preguntas No.3-4").Select
    Range("C6:F50,I6:L50").Select
        Selection.ClearContents
            Range("C6").Select
        
    Sheets("Preguntas No.5-6").Select
    Range("C6:F50,I6:L50").Select
        Selection.ClearContents
            Range("C6").Select
        
    Sheets("Preguntas No.7-8").Select
    Range("C6:D50,G6:H50").Select
        Selection.ClearContents
            Range("C6").Select
        
    Sheets("Preguntas No.9-10").Select
    Range("C6:D50,G6:J50").Select
        Selection.ClearContents
            Range("C6").Select
        
    Sheets("Preguntas No.11-12").Select
    Range("C6:F50,I6:L50").Select
        Selection.ClearContents
            Range("C6").Select

        
    Sheets("Preguntas No.13-14").Select
    Range("C6:F50,I6:L50").Select
        Selection.ClearContents
            Range("C6").Select
        MsgBox ("Contenido limpio de hojas Pregunta del No.1 a la 14")
    Sheets("Preguntas").Select
Application.ScreenUpdating = False
End Sub

[mrocf]

Fíjate si lo siguiente te sirve:

Código PHP:

Sub BorraContenido_new()
Dim mySh, myRng, i As Byte
 
mySh = Array( _
  "Preguntas No.1-2", "Preguntas No.3-4", "Preguntas No.5-6", _
  "Preguntas No.7-8", "Preguntas No.9-10", "Preguntas No.11-12", _
  "Preguntas No.13-14")
myRng = Array( _
  "C6:F50,I6:L50", "C6:F50,I6:L50", "C6:F50,I6:L50", "C6:D50,G6:H50", _
  "C6:D50,G6:J50", "C6:F50,I6:L50", "C6:F50,I6:L50")
 
Application.ScreenUpdating = False
For i = LBound(mySh) To UBound(mySh)
  Sheets(mySh(i)).Range(myRng(i)).ClearContents
Next i
Application.ScreenUpdating = True
 
MsgBox ("Contenido limpio de hojas Pregunta del No.1 a la 14")
End Sub
 

Saludos, Cacho R.

[JoaoM]

Una ves mas te doy las gracias Cacho, buen trabajo como siempre

[mrocf]

Me alegra que te haya sido de utilidad.

[JoaoM]

Se puede cerrar el tema y repito; GRACIAS MILES