Crear archivo y hoja de trabajo excel

Hola fejoal
Aprovechando tu generosidad y conocimientos te molesto por lo siguiente:
Tengo un archivo en la que voy a realizar cálculos de nominas llamado diario.xls hoja activa "calculos", en este archivo y en esta hola le introduzco lo siguiente:
En B1 nomina
En B2 el año 2002
En B3 la fecha, 07-mayo-2002, (la fecha varia de semana en semana, quincena en quincena, etc.), es decir no es la misma, varia.
Ahora lo que necesito es una macro que me haga lo siguiente:
A) Que de mi hoja "Calculos" me cree un archivo llamado nomina2002.xls (B1 union B2).
B) Que también me cree una hoja con el nombre de la fecha que puse en B3 y que me la ponga en A1 (recuerda que en el año van a hacer varias hojas, con el nombre de la fecha de B3).
C) Que esta macro me de por default de que si mi archivo nomina2002.xls existe ya no me lo cree, sino que por default me lo abra para trabajar.
D) OTra macro que mediante un botón, me copie los datos de la hoja llamada "calculos" del libro diario.xls me copie los datos a partir de B5 en adelante (las filas que estén activas a partir de B5) al nuevo archivo y a la nueva hoja. Te recuerdo que el archivo puede no ser nuevo si esta creado, la hoja si es diferente cada determinado tiempo, según la fecha en B3)
Gracias de antemano.
Atentamente: martin Rodriguez Cosme

1 Respuesta

Respuesta
1
Si bien de planteo simple, la elaboración de esta rutina no lo es tanto. De hecho me llevó más tiempo del que creía. EN particular por la cantidad de situaciones posibles que se pueden plantear (Que el archivo destino exista o no, que estuviera abierto, que la hoja a agregar ya estuviera...)
Amén de algunos datos necesarios que no proporcionaste (directorio donde buscar los archivos, celda donde pegar los datos de la hoja Cálculos).
Los siguientes procedimientos intentan resolver todas esta vicisitudes.
Inserta un módulo en el editor de visual basic y pega las siguientes líneas:
Sub CreaHoja()
Dim chk As String
Dim FileOp As Workbook
Dim SheetEx As Object
'=== Martín: escribe aquí el nombre de la carpeta donde debe buscar tu archivo Nómina....
PathFold = "C:\Mis Documentos\Martin"
'=====================================
MyFileName = Trim(Range("B1").Value & Range("B2").Value) & ".xls"
Mydate = Trim(IIf(IsDate(Range("b3").Value), Format(Range("b3").Value, "dd-mmmm-yyyy"), Range("b3").Value))
chk = Dir(PathFold & "\" & MyFileName)
'Control de Existencia del archivo
If chk = "" Then
Sheets("Calculos").Copy
ActiveWorkbook.SaveAs FileName:=MyFileName
Else
'control de archivo abierto
On Error Resume Next
Set FileOp = Workbooks(chk)
If Err <> 0 Then Workbooks.Open PathFold & "\" & MyFileName
On Error GoTo 0
End If
'Proceso de agregado de hoja en archivo NominaXXXX
Windows(MyFileName).Activate
ShNnom = Sheets.Count
On Error Resume Next
Set SheetEx = ActiveWorkbook.Sheets(Mydate)
If Err <> 0 Then
'creación de la hoja con fecha
On Error GoTo 0
Windows("Diario.xls").Activate
Sheets("Calculos").Select
Sheets.Add After:=Sheets(Sheets.Count)
'Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = Mydate
'pegado de fecha en A1
Sheets("Calculos").Select
Range("B3").Copy
Sheets(Mydate).Select
ActiveSheet.Paste
Selection.NumberFormat = "dd-mmmm-yyyy"
Columns("A:A").EntireColumn.AutoFit
'Exportar hoja a NominaXXXX
Sheets(Mydate).Move After:=Workbooks(MyFileName).Sheets(ShNnom)
Else
MsgBox "La hoja " & Mydate & " ya existe en libro " & MyFileName & Chr(10) & "Rutina termina aquí", vbInformation, "HOJA EXISTENTE"
End If
Sheets(Mydate).Select
Range("B5").Select
Windows("Diario.xls").Activate
Sheets("Calculos").Select
Range("B3").Select
Set SheetEx = Nothing
Set FileOp = Nothing
End Sub
Sub senddata()
Dim IniCell
'=== Martín: escribe aquí el nombre de la celda en la HOJA NUEVA
'desde donde debe pegar el dato:
IniCell = "B5"
'=====================================
Sheets("Calculos").Select
MyFileName = Trim(Range("B1").Value & Range("B2").Value) & ".xls"
Mydate = Trim(IIf(IsDate(Range("B3").Value), Format(Range("b3").Value, "dd-mmmm-yyyy"), Range("b3").Value))
Range(IniCell).CurrentRegion.Copy
Windows(MyFileName).Activate
Sheets(Mydate).Select
Range(IniCell).Select
If Not IsEmpty(Range(IniCell)) Then
ActiveCell.Offset(Range(IniCell).CurrentRegion.Rows.Count).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Range(IniCell).Select
End Sub
'--- Fin de códigos
Aquí tienes una rutina (CreaHoja) que:
- Controla que el archivo "nóminaXXXX" exista o no. (en el directorio que deberás escribir donde te indico)
Si no existe, lo crea a partir de la hoja Cálculos y lo graba con el nombre correspondiente.
- Si existe, averigua si está abierto en este momento o no.
Si no estuviera abierto, lo abre.
- Revisa si existe la hoja nueva que pretendes agregar.
Si estuviera, muestra un mensaje avisándolo y termina (nada más que hacer)
Si no existiera, la crea y la agrega al archivo nuevo. (Con la fecha en A1 y en su etiqueta)
----
La segunda macro es la que solicitaste para pasar los datos de la hoja cálculo a la hoja correspondiente según la fecha en ella.
Copiará todo los datos desde la celda B5 y los pegará en el área de destino. Aquí también deberás cambiar el parámetro de la celda de referencia (yo le puse, también B5).
Si no hubiera nada en esa celda inicial, pegará los datos a partir de ella.
Pero, si ya hubiera datos exportados, pegará lo nuevo en la celda inmediata inferior a la última línea ocupada.
Fiuuu... Martín. Prueba estos códigos y coméntame
Esto debería resolver tu pregunta. Si así fuera, agradeceré un comentario y que la finalices.
Si no, pregúntame de nuevo.
Un abrazo!
Fernando
Pd: Disculpa la demora pero estoy medio "tapado" de trabajo y esto demanda bastante tiempo...
Aclarando qué entendí mal o qué faltó.

Añade tu respuesta

Haz clic para o