Macro que envié correo automaticamente
Publicado por Johnny (4 intervenciones) el 18/01/2019 11:38:22
Hola buenas tardes o buenos días a tod@s.
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.
Esta 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
esta parte del código que dice EliminarIntermediario no la puedo hacer funcionar, ya que me copia todos los valores de esa y no copia los específicos (nombres de bancos) que necesito.
ojala me puedan ayudar.
en caso de que haga falta subir el archivo me lo hacen saber.
que tengan un buen días
Saludos.
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.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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 Sub
Esta 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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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 Sub
esta parte del código que dice EliminarIntermediario no la puedo hacer funcionar, ya que me copia todos los valores de esa y no copia los específicos (nombres de bancos) que necesito.
ojala me puedan ayudar.
en caso de que haga falta subir el archivo me lo hacen saber.
que tengan un buen días
Saludos.
Valora esta pregunta


0