Ejecutar bucle si una celda comienza por...

Saca 'copia a gastos de los "case"

ponlo aparte en un IF

'copia a gastos
IF Left(ActiveCell, 1) = 5 Then CopiaAGastos

(antes o después de Select case ... End select )

Gracias por responder, no me queda claro, ¿debo crear una macro nueva que se llame "copia a gastos"?, es decir:

'copia a gastos
if Left(ActiveCell, 1) = 5 then
Sheets("GASTOS").Select
ActiveSheet.Unprotect "xxxx"
Sheets("NOTA CONTAB").Select
Cells(celda, 2).Select
libre = Sheets("GASTOS").Range("A65536").End(xlUp).Row + 1
Sheets("GASTOS").Range("A" & libre) = Range("AA" & ActiveCell.Row) 'fecha
Sheets("GASTOS").Range("B" & libre) = Range("D" & ActiveCell.Row) 'concepto
Sheets("GASTOS").Range("C" & libre) = Range("I" & ActiveCell.Row) 'valor
Range("A" & libre).Select
Selection.NumberFormat = "dd/mm/yyyy;@"
Application.CutCopyMode = False
Sheets("NOTA CONTAB").Select
Case Else
End Select
End With
Next celda
End Sub

...Pero la condición "case" donde la incluyo para que repita la acción en las celdas siguientes?.

Gracias por la atención.

No tiene que ser una macro nueva, pero si es mas cómodo y es lo que te propongo

Con esa macro aparte hecha tu modulo quedaría asi

Sub Copiar_Nota_a_Caja_Gastos()Application.ScreenUpdating = FalseDim celda As LongFor celda = 13 To 100With Sheets("NOTA CONTAB").Cells(celda, 2)Select Case .Value'Copia a "movimiento"Case 11050501Sheets("MOVIMIENTO").SelectActiveSheet.Unprotect "xxxxx"Sheets("NOTA CONTAB").SelectCells(celda, 2).Selectlibre = Sheets("MOVIMIENTO").Range("A65536").End(xlUp).Row + 1Sheets("MOVIMIENTO").Range("A" & libre) = Range("AA" & ActiveCell.Row) 'fechaSheets("MOVIMIENTO").Range("B" & libre) = Range("D" & ActiveCell.Row) 'conceptoSheets("MOVIMIENTO").Range("C" & libre) = Range("I" & ActiveCell.Row) 'valorRange("A" & libre).SelectSelection.NumberFormat = "dd/mm/yyyy;@"Application.CutCopyMode = FalseSheets("NOTA CONTAB").Select'copia a banco1Case 11100501Sheets("BANCO1").SelectActiveSheet.Unprotect "xxxx"Sheets("NOTA CONTAB").SelectCells(celda, 2).Selectlibre = Sheets("BANCO1").Range("A65536").End(xlUp).Row + 1Sheets("BANCO1").Range("A" & libre) = Range("AA" & ActiveCell.Row) 'fechaSheets("BANCO1").Range("B" & libre) = Range("D" & ActiveCell.Row) 'conceptoSheets("BANCO1").Range("C" & libre) = Range("I" & ActiveCell.Row) 'valorRange("A" & libre).SelectSelection.NumberFormat = "dd/mm/yyyy;@"Application.CutCopyMode = FalseSheets("NOTA CONTAB").SelectCase ElseEnd Select

IF Left(ActiveCell, 1) = 5 Then CopiaAGastos

End WithNext celdaEnd Sub

Gracias por la respuesta, seguí al pie de la letra las instrucciones, cree la macro CopiaAGastos de la siguiente manera:

Sub CopiaAGastos()
Sheets("GASTOS").Select
ActiveSheet.Unprotect "xxxx"
Sheets("NOTA CONTAB").Select
libre = Sheets("GASTOS").Range("A65536").End(xlUp).Row + 1
Sheets("GASTOS").Range("A" & libre) = Range("AA" & ActiveCell.Row) 'fecha
Sheets("GASTOS").Range("B" & libre) = Range("D" & ActiveCell.Row) 'concepto
'asignar formatos en fila nueva
Range("A" & libre).Select
Selection.NumberFormat = "dd/mm/yyyy;@"
Application.CutCopyMode = False
Sheets("NOTA CONTAB").Select
End Sub

Luego en la macro inicial, antes de pasar a los gastos, escribí lo siguiente:

Case Else
End Select
'gastos
If Left(ActiveCell, 1) = 5 Then
Call CopiaAGastos
End With
Next celda
End Sub

Pero me sigue generando error, por ello cambié el End With por End If, pero algo está mal, la instrucción en ese punto no funciona.