Hoja que recopila datos
hola como estáis...tengo la intención de organizar una hoja que archive los datos de otras dos hojas... A2 b2 c2 d2 e2 f2
hoja clientes id cliente nombre fecha ciudad dirección teléfono
hoja producto a2 b2 c2 d2 e2 f2
id cliente cantidad articulo fabrica precio situación
la idea es hacer hoja archivo que cuando (hoja producto f2) ponga "servido" extraiga los valores de (hoja clientes) id cliente nombre fecha ciudad dirección teléfono y seguido
de hoja producto cantidad artitulo fabrica precio....
osea que ejecute macro al tocar botón que saque datos de las dos hojas y los deje en archivo
y borrase la fila de la hoja clientes y de producto quedando solo en hoja archivo....
muchas gracias
si queréis podría mandar hoja....
gracias
1 Respuesta
Te mando la macro.
Instrucciones
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5
'***Macro***
Sub clientes()
'Borra de gestion si situacion = servido
'Borra de clientes si no tiene nada en gestión y lo pasa a archivo
'Por.daM
Worksheets("CLIENTES").Select
ufil_clientes = ActiveCell.SpecialCells(xlLastCell).Row
ucol_clientes = ActiveCell.SpecialCells(xlLastCell).Column
Worksheets("GESTION").Select
ufil_gestion = ActiveCell.SpecialCells(xlLastCell).Row
ucol_gestion = ActiveCell.SpecialCells(xlLastCell).Column
Worksheets("ARCHIVO").Select
ufil_archivo = ActiveCell.SpecialCells(xlLastCell).Row
ucol_archivo = ActiveCell.SpecialCells(xlLastCell).Column
'inicia la con gestion
Worksheets("GESTION").Select
For i = 4 To ufil_gestion
If Cells(i, 7) = "SERVIDO" Then
'Si ya fue servido lo pasa a archivo y lo borra
num_cliente = Cells(i, 1)
Range(Cells(i, 3), Cells(i, 7)).Select
Range(Cells(i, 3), Cells(i, 7)).Copy
Worksheets("ARCHIVO").Select
ufil_archivo = ufil_archivo + 1
Cells(ufil_archivo, 8).Select
ActiveSheet.Paste
Worksheets("CLIENTES").Select
Range("A:A").Select
Set RangoObj = Selection.Find(What:=num_cliente, _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If RangoObj Is Nothing Then
MsgBox ("cliente no encontrado")
Else
k = RangoObj.Row
Range(Cells(k, 1), Cells(k, 7)).Select
Selection.Copy
Worksheets("ARCHIVO").Select
Cells(ufil_archivo, 1).Select
ActiveSheet.Paste
'Sheets("DATOS").Select
End If
Worksheets("GESTION").Select
ActiveCell.EntireRow.Delete
ufil_gestion = ActiveCell.SpecialCells(xlLastCell).Row
End If
Next 'fin gestion
'inicia clientes
Worksheets("CLIENTES").Select
For i = 4 To ufil_clientes
Cells(i, 1).Select
num_cliente = Cells(i, 1)
Worksheets("GESTION").Select
Range("A:A").Select
Set RangoObj = Selection.Find(What:=num_cliente, _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Worksheets("CLIENTES").Select
If RangoObj Is Nothing Then
ActiveCell.EntireRow.Delete
End If
Next
End Sub
'***Macro***Saludos.daM
