Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Unir dos Macros en una sola

Excel - Unir dos Macros en una sola

Volver
Nuevo Tema
<<>>
 
Vista:

Unir dos Macros en una sola

Publicado por Jorge (2 intervenciones) el 13/03/2018 22:02:34
Hola Amigos! Necesito unir dos macros en una sola. Una crea un archivo de excel nuevo y la otra copia las celdas de un archivo y lo guarda en este:

Macro que crea el archivo:



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
Sub createNewWorkbook()
    Dim newBook As Workbook
    Dim newSheet As Worksheet
    Dim name As String
    Set newBook = Workbooks.Add
    With newBook
        NombreArchivo = name
GuardarComo = Application.GetSaveAsFilename(InitialFileName:=NombreHoja, _
fileFilter:="Libro de Excel(*.xlsx), *.xlsx, Libro de Excel habilitado para macros(*.xlsm), *.xlsm, Libro de Excel 97-2003(*.xls), *.xls,CSV (delimitado por comas)(*.csv),*.csv", _
Title:="EXCELeINFO - guadar hoja activa como archivo nuevo.")
If GuardarComo = False Then
Workbooks(NombreArchivo).Close SaveChanges:=False
Else
With Application.WorksheetFunction
Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
End With
 
Select Case Extension
Case Is = "xlsx"
ActiveWorkbook.SaveAs GuardarComo
Case Is = "xlsm"
ActiveWorkbook.SaveAs GuardarComo, xlOpenXMLWorkbookMacroEnabled
Case Is = "xls"
ActiveWorkbook.SaveAs GuardarComo, xlExcel8
Case Is = "csv"
ActiveWorkbook.SaveAs GuardarComo, xlCSV
Case Else
ActiveWorkbook.SaveAs GuardarComo
End Select
End If
    End With
 
    Set newSheet = newBook.Sheets.Add
 
    newSheet.Cells(1, 1).Value = "You have created a new Workbook"
 
    newBook.Close (True)
End Sub

Macro que copia las celdas

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub CopiarCeldas()
Dim wbDestino As Workbook, _
    wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
Set wbDestino = Workbooks.Open("C:\Users\Jorge\Desktop\Training\Libro5.xlsx")
ThisWorkbook.Activate
Set wsOrigen = Worksheets("Carga")
Set wsDestino = wbDestino.Worksheets("Hoja1")
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
rngDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False
wbDestino.Save
wbDestino.Close
End Sub

***Lo que me gustaría es tener todo esto en una sola macro y que mi actual "macro 2" seleccione el archivo previamente creado y no uno especifico como esta ahorita.

Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Unir dos Macros en una sola

Publicado por Antoni Masana (2540 intervenciones) el 14/03/2018 07:26:23
Tienes dos opciones

Opción 1
1
2
3
4
Sub Macro2
    Call createNewWorkbook()
    Call CopiarCeldas()
End Sub


Opción 2
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
Sub createNewWorkbook_y_CopiarCeldas()
    Dim newBook As Workbook
    Dim newSheet As Worksheet
    Dim name As String
 
    Set newBook = Workbooks.Add
    With newBook
        NombreArchivo = name
        GuardarComo = Application.GetSaveAsFilename(InitialFileName:=NombreHoja, _
                        fileFilter:="Libro de Excel(*.xlsx), *.xlsx, " + _
                                    "Libro de Excel habilitado para macros(*.xlsm), *.xlsm, " + _
                                    "Libro de Excel 97-2003(*.xls), *.xls, " + _
                                    "CSV (delimitado por comas)(*.csv),*.csv", _
                        Title:="EXCELeINFO - guadar hoja activa como archivo nuevo.")
 
        If GuardarComo = False Then
            Workbooks(NombreArchivo).Close SaveChanges:=False
        Else
            With Application.WorksheetFunction
                Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
            End With
 
            Select Case Extension
                Case Is = "xlsx": ActiveWorkbook.SaveAs GuardarComo
                Case Is = "xlsm": ActiveWorkbook.SaveAs GuardarComo, xlOpenXMLWorkbookMacroEnabled
                Case Is = "xls":  ActiveWorkbook.SaveAs GuardarComo, xlExcel8
                Case Is = "csv":  ActiveWorkbook.SaveAs GuardarComo, xlCSV
                Case Else:        ActiveWorkbook.SaveAs GuardarComo
            End Select
        End If
    End With
    Set newSheet = newBook.Sheets.Add
    newSheet.Cells(1, 1).Value = "You have created a new Workbook"
    newBook.Close (True)
 
    Dim wbDestino As Workbook, _
        DwsOrigen As Excel.Worksheet, _
        DwsDestino As Excel.Worksheet, _
        rngOrigen As Excel.Range, _
        SrngDestino As Excel.Range
 
    WSet wbDestino = Workbooks.Open("C:\Users\Jorge\Desktop\Training\Libro5.xlsx")
    ThisWorkbook.Activate
    Set wsOrigen = Worksheets("Carga")
    Set wsDestino = wbDestino.Worksheets("Hoja1")
    Const celdaOrigen = "A1"
    Const celdaDestino = "A1"
    Set rngOrigen = wsOrigen.Range(celdaOrigen)
    Set rngDestino = wsDestino.Range(celdaDestino)
    rngOrigen.Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    rngDestino.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    wbDestino.Save
    wbDestino.Close
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Unir dos Macros en una sola

Publicado por Víctor Vigo Valera (1 intervención) el 27/12/2020 23:31:27
Señores.
Saludos y muy amable por la instrucción .
Me fue de mucha ayuda.

Se agradece desde Cajamarca - Perú.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar