Excel - Macro que segun condicion pega en otra Hoja

 
Vista:
sin imagen de perfil
Val: 3
Ha aumentado su posición en 15 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro que segun condicion pega en otra Hoja

Publicado por MARCO (3 intervenciones) el 28/05/2018 08:05:15
Buenas,

Deseo realizer una Macro que no he podido dar con ella, les explico el funcionamiento deseado:

El archive tiene las siguientes Hojas :
Hoja "Origen"
Hojas "DNI" (Una Hoja para cada numero de DNI)

Ahora en la Hoja Origen en la columna "A" tiene los numeros de "DNI", que pudieran repetirse en varias filas, ya que existe informacion variada para cada DNI, como por ejemplo paises visitados, lo que quiero es que la macro evalue la Hoja Origen y copie los paises visitados y precio del pasaje en la hoja con el nombre del DNI a partir de la celda B39 para el pais y c 39 para el precio del pasaje.

A manera ilustrativa la hoja "origen" seria algo asi:

Columna A Columna B Columna C
Fila 1 DNI=123 Peru 2.000 Pesos
Fila 2 DNI= 456 Colombia 1.000 Pesos
Fila 3 DNI= 123 Argentina 3.000 Pesos

La Hoja llamada 123 tendria como resultado

Columna A Columna B
Fila 39 Peru 2.000 Pesos
Fila 40 Argentina 3.000 Pesos

La Hoja llamada 456 tendria como resultado

Columna A Columna B
Fila 39 Colombia 1.000 Pesos

NOTA: no son solo Pais y Precio, tendria varias columnas cuya informacion queria pasar a la hoja DNI, coloque solo 2 como ejemplo,

Gracias de antemano por su apoyo a los super expertos del area!
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
sin imagen de perfil
Val: 3
Ha aumentado su posición en 15 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro que segun condicion pega en otra Hoja

Publicado por MARCO (3 intervenciones) el 28/05/2018 09:07:57
Empece con esta macro, pero no se como ir a la hoja segun el valor de la columna, por eso hay una sola llamada Destino, :

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
Sub Actualizar()
 
'Definir objetos a utilizar
Dim wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
 
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("Origen")
Set wsDestino = Worksheets("Destino")
 
'Indicar la celda de origen y destino
Const celdaOrigen = "Q2"
Const celdaDestino = "C39"
 
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
 
'Seleccionar rango de celdas origen
Sheets("Origen").Select
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
 
'Pegar datos en celda destino
rngDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
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
Imágen de perfil de Antoni Masana
Val: 4.149
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro que segun condicion pega en otra Hoja

Publicado por Antoni Masana (1459 intervenciones) el 28/05/2018 12:44:25
Esta es un ejemplo simple y que funciona bien una sola vez, si la ejecutas una segunda vez repite la información en las hojas destino.
Falta alguna cosa y no esta probada es más para ver la estructura.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Actualizar()
    Dim Fila_Orig as Long, DNI as String, _
        Fila_Dest as Long, Pai as String, Prc as String
 
    Worksheets("Origen").Select
    Fila_Orig=1
    while Cells(Fila_Orig, 1) <> ""
        DNI = Cells(Fila_Orig, 1)  ' --- Dni
        PAI = Cells(Fila_Orig, 2)  ' --- Pais
        PRC = Cells(Fila_Orig, 2)  ' --- Precio
 
        WorkSheet(DNI).Select
        File_Dest=39
        while Cells(Fila_Orig, 1) <> ""
            Fila_Dest = Fila_Dest + 1
        Wend
        Cells(Fila_Dest, 1) = PAI
        Cells(Fila_Dest, 2) = PRC
 
        Worksheets("Origen").Select
        Fila_Orig = Fila_Orig + 1
    Wend
End Sub

¿Cómo funciona?
Recorre la hoja Origen toma los datos, salta a la hoja del DNI y a partir de la fila 39 busca la primera libre para pegar los datos.

Para que la macro este perfecta tendría que crear una tabla e ir añadiendo cual es la siguiente línea libre de cada DNI, porque así al ir añadiendo datos en la hoja principal añadiría a las hojas de DNI los nuevos datos y no volvería a copiar los primeros como pasa con esta y cada vez que va a una hoja de DNI no tendría que estar buscando la primera línea vacía.

Para hacer eso necesitaría un fichero para las pruebas.

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

Macro que segun condicion pega en otra Hoja

Publicado por Marco (3 intervenciones) el 28/05/2018 14:59:41
Hola, Me ayudaron con este codigo:

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
Public Sub SpreadData()
Dim ws As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long
 
    Application.ScreenUpdating = False
 
    With ActiveWorkbook.Worksheets("Data_C")
 
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lastrow
 
            Set ws = wsExists(.Cells(i, "A").Value)
            If ws Is Nothing Then
 
 
              Set ws = ActiveWorkbook.Worksheets.Add(after:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
 
                ws.Name = .Cells(i, "A").Value
 
 
                ws.Range("B1:C1").Value = Array("Country", "Amount") '<<<< extend range and values to suit
            End If
 
            nextrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
            ws.Cells(nextrow, "B").Value = .Cells(i, "B").Value
            ws.Cells(nextrow, "C").Value = .Cells(i, "C").Value
            '<<<< exted for more columns
        Next i
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Private Function wsExists(ByVal wsName As String) As Worksheet
Dim ws As Worksheet
 
    On Error Resume Next
    Set ws = ActiveWorkbook.Worksheets(wsName)
    On Error GoTo 0
 
    Set wsExists = ws
End Function

Pero igualmente tiene dos detalles, 1.- No sobreescribe la data, duplicandola y 2.- La hoja creada es nueva y necesito que sea una copia de una llamada "Modelo", gracias por la ayuda.
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