¿Cómo agrego un archivo como plantilla para este código?

Hola experto, buenas tardes:

Necesito usar un archivo como plantilla para la siguiente macro:

Sub ur()

Set h1 = Sheets(ActiveSheet.Name)

ActiveSheet.AutoFilterMode = False Application.DisplayAlerts = False Application.ScreenUpdating = False

Set urinicial = h1.Range("b4")

fini = urinicial.Row

cini = urinicial.Column

ufila = Cells(Rows.Count, cini).End(xlUp).Row

copiar = MsgBox(" Copiar datos " & vbNewLine & vbNewLine & "SI = Copiar, No = Pegar valores, Cancel = Salir ", vbQuestion + vbYesNoCancel, "Copiar UR")

If copiar = vbCancel Then Exit Sub

Range(Cells(fini, cini), Cells(ufila, cini)).Copy

Set h2 = Sheets.Add

ActiveSheet.Paste

Application.CutCopyMode = False

Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

For i = 2 To h2.Range("B" & Rows.Count).End(xlUp).Row

Application.StatusBar = "Procesando UR " & i & " de " & h2.Range("B" & Rows.Count).End(xlUp).Row

h1.Select

ActiveSheet.AutoFilterMode = False

Rows(fini & ":" & fini).Select

Selection.AutoFilter

Selection.AutoFilter Field:=cini, Criteria1:=h2.Cells(i, "B")

Range("A" & fini).Select

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

Selection.Copy

Workbooks.Add "C:\\PRESUPUESTO\PLANTILLA PEF.xls" (este es el archivo que necesito como plantilla para crear los libros nuevos)

If copiar = vbYes Then

ActiveSheet.Paste

Else

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

Application.CutCopyMode = False

carpeta = ThisWorkbook.Path & "\"

ActiveWorkbook.SaveAs Filename:=carpeta & h2.Cells(i, "B") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close

conta = conta + 1

h1.Select

Next h2.Delete

Application.DisplayAlerts = True

ActiveSheet.AutoFilterMode = False Application.StatusBar = False

MsgBox "Proceso Terminado " & vbNewLine & vbNewLine & "Se crearon " & contá & " Archivos", vbInformation, "Copia de UR"

End Sub

Los problemas que tengo son:

1.- A la hora de pegar los datos me dice que hay error porque el área a copiar de pegado son diferentes.

2.- Necesito que los datos siempre se peguen en la celda a4

3.- El encabezado corresponde a las 3 primeras filas sin embargo algunas están combinadas.

4.- ¿Hay algún problema si necesito usar la versión 97-2003?

Muchas gracias por su atención, espero su respuesta.

1 Respuesta

Respuesta
1

En la macro después de esta línea

Workbooks.Add "C:\\PRESUPUESTO\PLANTILLA PEF.xls"

escribe esta

range("B4").select

Prueba y me comentas

Saludos. DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas