Tengo un problema con esta macro que estoy tratando de hacer, básicamente la función que debe realizar la macro es la siguiente, de un grupo de archivos cargarlos en una plantilla que ya tengo establecida, los clasifique por tipo, es decir que según el nombre del archivo me lo clasifique como tipo (físico o compensado). el programa que me arroja la base de datos tiene la misma estructura, es decir misma columnas, misma descripción de los títulos, pero la diferencia esta en que al momento de darme el archivo me los guarda con nombre distintos, y lo que quiero hacer es que según ese nombre de archivo me los clasifique como tipo Físico o Compensado.
Estas son las estructuras de codigos que tengo.
esta es para cargar los archivos a a mi base de datos, me dijeron que dentro de este mismo código tenia que dar la instrucción pero yo lo dividí en dos.
Código: Seleccionar todo
Sub Importar()
Dim file As String
Dim xlLibro As Workbook
Dim i As Integer
Application.ScreenUpdating = False
Worksheets("base").Range("A2:AB65000").ClearContents
fileToopen = Application _
.GetOpenFilename("Todos los archivos (*.*), *.*")
If fileToopen <> False Then
Set xlLibro = Workbooks.Open _
(fileToopen, True, True, , "")
file = ActiveWorkbook.Name
ActiveSheet.Range("A1:AB65000").Copy
Windows("prueba 5.xlsm").Activate
Sheets("base").Select
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
Application.Workbooks(file).Activate
ActiveSheet.Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Close (False)
Windows("prueba 5.xlsm").Activate
Sheets("inicio").Select
Range("A1").Select
ActiveWorkbook.RefreshAll
End If
Sheets("inicio").Activate
ActiveSheet.Range("A1").Select
MsgBox "Datos Importados Correctamente"
End SubEsta otra parte me carga los datos a la plantilla, les da formato numérico a las filas especificas que necesito y copia los datos que solemnemente necesito
Código: Seleccionar todo
Sub CyPv()
Worksheets("base").Activate
Columns("D:D").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
End Sub
Sub EliminarIntermediario()
Dim i As Integer
i = 2
Dim j As Integer
Do While Worksheets("base").Cells(i, 1) <> ""
i = i + 1
Loop
Ultimo = i - 1
For j = Ultimo To 2 Step -1
If Worksheets("base").Cells(j, 4) = "No" Then
Worksheets("base").Cells(j, 1).EntireRow.Delete
End If
Next j
End Sub
Sub CopiarDatos()
Dim i As Integer
i = 2
Do While Worksheets("base").Cells(i, 1) <> ""
i = i + 1
Loop
Ultimo = i - 1
x = 3
For j = 2 To Ultimo
If Worksheets("base").Cells(j, 1) <> "" Then
Worksheets("inicio").Cells(x, 3) = Worksheets("base").Cells(j, 4)
Worksheets("inicio").Cells(x, 4) = Worksheets("base").Cells(j, 6)
Worksheets("inicio").Cells(x, 5) = Worksheets("base").Cells(j, 8)
Worksheets("inicio").Cells(x, 6) = Worksheets("base").Cells(j, 9)
Worksheets("inicio").Cells(x, 7) = Worksheets("base").Cells(j, 10)
x = x + 1
End If
Next j
End Sub
Sub FormatoNumeros()
Worksheets("inicio").Activate
Range("E3:E21,G3:G21").Select
Range("G3").Activate
Selection.NumberFormat = "#,##0.00"
Range("B2").Select
End Subojala me puedan ayudar.
en caso de que haga falta subir el archivo me lo hacen saber.
que tengan un buen días
Saludos.
