RE:Como marcar celdas iguales en una misma columna
Tengo un libro que funciona muy parecido a lo que quieres hacer en el codigo de la Hoja inicial pon esto:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fact1 As Range
Set Fact1 = Range("D2")
If Target.Address = Fact1.Address Then Call Factu1
Dim Fact2 As Range
Set Fact2 = Range("D3")
If Target.Address = Fact2.Address Then Call Factu2
Dim Fact3 As Range
Set Fact3 = Range("D4")
If Target.Address = Fact3.Address Then Call Factu3
Dim Fact4 As Range
Set Fact4 = Range("D5")
If Target.Address = Fact4.Address Then Call Factu4
Dim Fact5 As Range
Set Fact5 = Range("D6")
If Target.Address = Fact5.Address Then Call Factu5
Dim Fact6 As Range
Set Fact6 = Range("D7")
If Target.Address = Fact6.Address Then Call Factu6
Dim Fact7 As Range
Set Fact7 = Range("D8")
If Target.Address = Fact7.Address Then Call Factu7
End Sub
En un modulo nuevo pon esto:
Sub Factu1()
Sheets.Add
Sheets("Hoja2").Select
Sheets("Hoja2").Move After:=Sheets(2)
Sheets("Hoja2").Select
Sheets("Hoja2").Name = Workbooks.Application.Worksheets(1).Range("D2").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A2:D2").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
Sub Factu2()
Sheets.Add
Sheets("Hoja3").Select
Sheets("Hoja3").Move After:=Sheets(2)
Sheets("Hoja3").Select
Sheets("Hoja3").Name = Workbooks.Application.Worksheets(1).Range("D3").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A3:D3").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
Sub Factu3()
Sheets.Add
Sheets("Hoja4").Select
Sheets("Hoja4").Move After:=Sheets(2)
Sheets("Hoja4").Select
Sheets("Hoja4").Name = Workbooks.Application.Worksheets(1).Range("D4").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A4:D4").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
Sub Factu4()
Sheets.Add
Sheets("Hoja5").Select
Sheets("Hoja5").Move After:=Sheets(2)
Sheets("Hoja5").Select
Sheets("Hoja5").Name = Workbooks.Application.Worksheets(1).Range("D5").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A5:D5").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
Sub Factu5()
Sheets.Add
Sheets("Hoja6").Select
Sheets("Hoja6").Move After:=Sheets(2)
Sheets("Hoja6").Select
Sheets("Hoja6").Name = Workbooks.Application.Worksheets(1).Range("D6").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A6:D6").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
Sub Factu6()
Sheets.Add
Sheets("Hoja7").Select
Sheets("Hoja7").Move After:=Sheets(2)
Sheets("Hoja7").Select
Sheets("Hoja7").Name = Workbooks.Application.Worksheets(1).Range("D7").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A7:D7").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
Sub Factu7()
Sheets.Add
Sheets("Hoja8").Select
Sheets("Hoja8").Move After:=Sheets(2)
Sheets("Hoja8").Select
Sheets("Hoja8").Name = Workbooks.Application.Worksheets(1).Range("D8").Value
ActiveSheet.Previous.Select
Range("A1:D1").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A1.D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Previous.Select
Range("A8:D8").Select
Selection.Copy
ActiveSheet.Next.Select
Range("A2.D2").Select
ActiveSheet.Paste
ActiveSheet.Protect Password:="tavo", DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Application.CutCopyMode = False
ActiveSheet.Previous.Select
End Sub
*** Debes reutilizar el codigo para el N hojas que necesites