Unir Rangos y pegarlos en forma Apilada en otra hoja
Tengo el siguiente proyecto, me genera el día Jueves bien, pero una segundo día ya me dice error 1004
Método PasteSpecial de la clase Range
Llamo en lo individual y en un botón que me llama todas las macros juntas y es el mismo resultado.
PARA MI UF=ULTIMA FILA Y MRG= rangos que estoy uniendo a según el día de la semana (J, V, ES, D..
Option Explicit
Sub SEMANAHACIAABAJO1()
'PARTE JUEVES
Dim UF As Long
Dim sh As Worksheet
Dim MRGJ As Range
Set sh = ThisWorkbook.Worksheets("Semana")
With sh
UF = .Cells(.Rows.Count, "B").End(xlUp).Row
Set MRGJ = Union(.Range("A3:H" & UF), .Range("I3:L" & UF))
End With
MRGJ.Copy
Sheets("diaria").Select
Range("A3:L3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub SEMANAHACIAABAJO2()
'PARTE VIERNES
Dim UF As Long
Dim sh As Worksheet
Dim MRGV As Range
Set sh = ThisWorkbook.Worksheets("Semana")
With sh
UF = .Cells(.Rows.Count, "B").End(xlUp).Row
Set MRGV = Union(.Range("A3:H" & UF), .Range("M3:P" & UF))
End With
MRGV.Copy
Sheets("diaria").Select
Range("A3:L3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub SEMANAHACIAABAJO3()
'PARTE SABADO
Dim UF As Long
Dim sh As Worksheet
Dim MRGS As Range
Set sh = ThisWorkbook.Worksheets("Semana")
With sh
UF = .Cells(.Rows.Count, "B").End(xlUp).Row
Set MRGS = Union(.Range("A3:H" & UF), .Range("Q3:T" & UF))
End With
MRGS.Copy
Sheets("diaria").Select
Range("A3:L3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Son 8 columnas Base de ahí 4 columnas de cada día de la semana... que necesito pasar a otra hoja 8 columnas más el día jueves, después 8 columnas más el día viernes...
La primera Hoja se llama semana la segunda diaria( los mismos datos pero solo un día por fila, todos hacia abajo)
Gracias de Antemano
Prueba lo siguiente
Sub copiar_dias()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, j As Long, uf1 As Long, uf2 As Long
Set sh1 = Sheets("Semana")
Set sh2 = Sheets("diaria")
uf1 = sh1.Range("A" & Rows.Count).End(3).Row
j = 9
For i = 1 To 7
uf2 = sh2.Range("A" & Rows.Count).End(3).Row + 1
sh2.Range("A" & uf2).Resize(uf1 - 2, 8).Value = sh1.Range("A3:H" & uf1).Value
sh2.Range("I" & uf2).Resize(uf1 - 2, 4).Value = sh1.Range(sh1.Cells(3, j), sh1.Cells(uf1, j + 3)).Value
j = j + 4
Next
End Sub
