Copiar filas en una hoja nueva

Aqui lo tienes:

Sub copiarfilas()
Dim UltimaFilaHoja1 As Long
Dim UltimaFilaHoja2 As Long
Dim UltimaFilaHoja3 As Long
Dim UltimaFilaHoja4 As Long
Dim Fila As Long
Dim NumeroFila As Long


Dim Hoja1 As Worksheet
Dim Hoja2 As Worksheet
Dim Hoja3 As Worksheet
Dim Hoja4 As Worksheet
Dim Hoja5 As Worksheet

Set Hoja1 = Worksheets("Hoja1")
Set Hoja2 = Worksheets("Hoja2")
Set Hoja3 = Worksheets("Hoja3")
Set Hoja4 = Worksheets("Hoja4")
Set Hoja5 = Worksheets("Hoja5")

UltimaFilaHoja1 = Hoja1.Range("a65536").End(xlUp)
UltimaFilaHoja2 = Hoja2.Range("a65536").End(xlUp)
If UltimaFilaHoja2 <> UltimaFilaHoja1 Then
MsgBox "Numero de filas distinto·"
Exit Sub
End If
UltimaFilaHoja3 = Hoja3.Range("a65536").End(xlUp)
If UltimaFilaHoja2 <> UltimaFilaHoja1 Then
MsgBox "Numero de filas distinto·"
Exit Sub
End If
UltimaFilaHoja4 = Hoja4.Range("a65536").End(xlUp)
If UltimaFilaHoja2 <> UltimaFilaHoja1 Then
MsgBox "Numero de filas distinto·"
Exit Sub
End If


For Fila = 1 To UltimaFilaHoja1
NumeroFila = (Fila - 1) * 4
Hoja1.Rows(Fila).Copy Hoja5.Rows(1 + NumeroFila)
Hoja2.Rows(Fila).Copy Hoja5.Rows(2 + NumeroFila)
Hoja3.Rows(Fila).Copy Hoja5.Rows(3 + NumeroFila)
Hoja4.Rows(Fila).Copy Hoja5.Rows(4 + NumeroFila)
Next
MsgBox "finalizado"

End Sub





Mostrar la cita

Hola a todos. (perdon por el reposteo, me equivoque y se

me paso hacer
Mostrar la cita

hilo nuevo)

Queria saber si puedo hacer lo siguiente:
Tengo un libro con 4 hojas. Las hojas tienen identica

estructura aunque
Mostrar la cita

datos diferentes. Quiero hacer una hoja nueva que tenga

las filas de las
Mostrar la cita

otras cuatro ordenadas de modo que la primera fila sea la

primera de la
Mostrar la cita

primera hoja, la segunda la primera de la segunda hoja, la

tercera la
Mostrar la cita

primera de la tercera hoja y la cuarta la primera de la

cuarta hoja. Es
Mostrar la cita

decir, una tabla que reuna todas las filas pero ordenadas

por la primera
Mostrar la cita

columna de cada hoja (es una fecha). No tengo problema

para hacerlo con
Mostrar la cita

la primera fila mediante esta macro que encontre, pero

solo me extrae la
Mostrar la cita

primera fila, ¨como se puede repetir para todas?


Sub Test4()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long



On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name)

0 Then
Mostrar la cita

On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)



sh.Rows("3").Copy DestSh.Cells(Last + 1, "A")
End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

La funcion LastRow es:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Lo que quiero es esto pero para la totalidad de las hojas.


Gracias de antemano. Perdon por lo extenso.


Salu2. Martin


.