Macro para separ datos

Hola experto.
Necesito ayuda espero tu puedas hacerlo. Te explico:
Tengo 3 hojas la hoja 1 la recibo 3 o 4 veces por mes y es acumulativa, es decir que los datos que me enviaron la primera vez me llegan la segunda junto con más datos.
Esos datos yo los ordeno y los paso a la hoja 2 y 3 dependiendo si de si cumplen con la siguiente condición si el la columna DE tienen la palabra "pago", "cheque" o "cheq" se van junto con toda su fila a ala hoja 3 y si no se van a la hoja 2, .
Todo esto de la siguiente manera:
La columna A de la hoja 1 pasa a la columna C
la columna E de la hoja 1 se mantiene en la columna E
la columna F de la hoja 1 se mantiene en la columna F
la columna H de la hoja 1 pasa a la columna B
la columna I de la hoja 1 se mantiene en la columna I
La columna H de la hoja 1 q pasa a la columna C tiene un folio único con el cual podríamos identificar cula fuel el ultimo dato q pasamos a las hoja 2 y 3 respectivamente; o en el caso de que fuera un mes nuevo seria en la primera celda vacía depus de los títulos.
La otra forma esque  yo le pudira indicar a la macro desde que fila de la hoja 1 enpezara copiar los datos;
Espero haber sido lo suficientemente claro, para que puedas ayudarme.
Gracias!

1 Respuesta

Respuesta
1
creo que si entendí... pero!
Unas preguntas:
¿Cuándo dices que se mantiene o pasa, te refieres a que se mantiene o pasa en la columna pero de la hoja 2 o 3 según corresponda?
Primero dices que la columna h pasa a la b, y luego dices que la misma h pasa a la c... ¿o sea como?
En cuanto a lo de desde que fila, si se puede hacer desde la macro, pero para que el proceso sea automático necesita que la fila o siempre tenga el mismo numero de filas por hoja1 o que estén identificadas por cada hoja1 diferente (puede ser un espacio en blanco, o alguna marca)...
Todo esto de la siguiente manera:
La columna A de la hoja 1 pasa a la columna C
la columna E de la hoja 1 pasa a la columna E
la columna F de la hoja 1 pasa a la columna F
la columna H de la hoja 1 pasa a la columna B
la columna I de la hoja 1 pasa a la columna I
la columna B de la hoja 1 pasa a la columna L
la columna DE de la hoja 1 pasa a la columna M
Esto dependiendo de si cumplen con la condición:
Si en la columna DE tienen la palabra "pago", "cheque" o "cheq" se van junto con toda su fila a la hoja 3 y si no se van a la hoja 2.
Y con respecto a desde que fila... Yo ingresara una fila en blanco, esto cuando fuera el segundo o tercer envío del mes y en el primer envío se me ocurre también ingresar una fila en blanco entre los la fila 1 y la fila 2 (en este ultimo caso no se si fuera necesario). En las hojas 2 y 3 los datos se anexarían a partir de la ultima celda vacía de la columna B.
Ahhh, como abras notado agregue dos columnas y me parece necesario decirte que me gustaría que solo se copiaran los valores, esto para mantener el formanto de las hojas 2 y/o  3.
Gracias por tu tiempo y paciencia!
Esta parte del código te sirve para el primer envío...
Dim celda As Range
For Each celda In Sheets(1).Range("d1", Range("d65000").End(xlUp))
If celda.Value = "pago" Or celda.Value = "cheque" Or celda.Value = "cheq" Then
celda.EntireRow.Select
Selection.Copy
Sheets(3).Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Else
Sheets(2).Range("c65000").End(xlUp).Offset(1, 0) = celda.Offset(0, -3).Value
Sheets(2).Range("e65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 1).Value
Sheets(2).Range("f65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 2).Value
Sheets(2).Range("b65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 4).Value
Sheets(2).Range("i65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 5).Value
Sheets(2).Range("l65000").End(xlUp).Offset(1, 0) = celda.Offset(0, -2).Value
Sheets(2).Range("m65000").End(xlUp).Offset(1, 0) = celda.Value
End If
Next
sin embargo lo de los demas envios, me surge una duda...tu no kieres que los datos repetidos en el segundo, tercer o cuarto envio se copien a las hojas 2 o 3 vdd? o si?
Si la respuesta es no... entonces, como tu lo dices, se pudiese poner una condición con respecto a la columna h (donde dices que son valores únicos), de que si no hay datos que coincidan con el valor actualmente evaluado que siga con la macro y en caso contrario que pase al siguiente valor a evaluar.
Si la respuesta es si... entonces no hay problema el código que te mando correría para cualquier valor en la hoja 1 columna d...
Si quieres puedes mandarme tu archivo o alguna prueba para ayudarte mejor... mi correo es [email protected]
Gracias es casi lo que necesito.
Te lo envío.
Que ondas alasdefuego!
Ya te lo envíe por correo... este es el código:
Application.ScreenUpdating = False
Dim celda As Range
hactiva = ActiveSheet.Name
Sheets("BANCO 1").Select
Range(Range("a65000").End(xlUp).Offset(1, 0).Address, Range("m65000").End(xlUp).Offset(1, 0).Address).Select
Selection.ClearContents
Sheets("BANCO 2").Select
Range(Range("a65000").End(xlUp).Offset(1, 0).Address, Range("m65000").End(xlUp).Offset(1, 0).Address).Select
Selection.ClearContents
Sheets(hactiva).Activate
For Each celda In ActiveSheet.Range("d2", Range("d65000").End(xlUp))
If celda.Value = "PAGO CHEQUE" Or celda.Value = "PAG CHQ OI" Or celda.Value = "PGO CHQ DEPCTA" Then
hoja = "BANCO 2"
Else
hoja = "BANCO 1"
End If
Sheets(hoja).Range("c65000").End(xlUp).Offset(1, 0) = celda.Offset(0, -3).Value
Sheets(hoja).Range("e65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 1).Value
Sheets(hoja).Range("f65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 2).Value
Sheets(hoja).Range("b65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 4).Value
Sheets(hoja).Range("i65000").End(xlUp).Offset(1, 0) = celda.Offset(0, 5).Value
Sheets(hoja).Range("m65000").End(xlUp).Offset(1, 0) = celda.Offset(0, -2).Value
Sheets(hoja).Range("l65000").End(xlUp).Offset(1, 0) = celda.Value
Next
Application.ScreenUpdating = True
MsgBox "YA ESTA LISTO!!!", , "LISTO"
Te aconsejo que lo cargues en la barra de herramientas de acceso rapido, más comandos, comandos disponibles en, macros y seleccionas el nombre de tu macro, agregar (le puedes poner el icono que desees).
La macro corrara al presionar el icono, para la hoja que este activa...
Cualquier duda me echas un grito...
Funciona mejor de lo que esperaba. De hecho me doy cuenta que detecta si hay datos de otros meses y de ser así los borra y comienza con otro mes desde cero. Corrígeme si me equivoco!
Por último podrías agregarle a la macro la orden que al las filas que en en la columna "F" del libro "Banco 1" tengan datos las vaya mandando al final de la misma hoja. Aunque no se si esta orden se podría ejecutar después de cada envío, realizado durante el mes, ¿o si solo se podría ejecutar el final de cada mes? De ser posible me gustaría que la primera opción fuera la que utilizáramos, sino la segunda esta bien.
Gracias por tu tiempo!
Alas de fuego!...
Te explico, no es que detecte si hay o no hay datos de otros meses, lo que pasa es que como vi que tenias los envíos en diferentes hojas lo único que hice fue que antes de empezar a ejecutar la macro, limpiara todas las celda... de cualquier forma los datos del primer envío están en el segundo, así no pierdes información y tampoco se repiten.
Habrás notado que cambie algunas cosas, pues tu decías que sin en la col de decía por, y o z pasaba toda la fila pero si lo haces no coincidirían los datos... también invertí las col l y m
por lo que me pides me di cuenta que hay un error, de echo la macro no debió haberte funcionado como te funciono, pues las celda que en apariencia están vacías no lo están, tienen espacios en blanco (también son caracteres) pero ya lo corregí... sustituye todo lo que te pase por este código:
Sub RAPIDO()
Application.ScreenUpdating = False
Dim celda As Range
hactiva = ActiveSheet.Name
Sheets("BANCO 1").Select
Range(Range("a65000").End(xlUp).Offset(1, 0).Address, Range("m65000").End(xlUp).Offset(1, 0).Address).Select
Selection.ClearContents
Sheets("BANCO 2").Select
Range(Range("a65000").End(xlUp).Offset(1, 0).Address, Range("m65000").End(xlUp).Offset(1, 0).Address).Select
Selection.ClearContents
Sheets(hactiva).Activate
fila1 = 6
fila2 = 6
For Each celda In ActiveSheet.Range("d2", Range("d65000").End(xlUp))
If celda.Value = "PAGO CHEQUE" Or celda.Value = "PAG CHQ OI" Or celda.Value = "PGO CHQ DEPCTA" Then
fila1 = fila1 + 1
Sheets("BANCO 2"). Cells(fila1, 3) = celda. Offset(0, -3). Value
Sheets("BANCO 2"). Cells(fila1, 5) = celda. Offset(0, 1). Value
Sheets("BANCO 2"). Cells(fila1, 6) = celda. Offset(0, 2). Value
Sheets("BANCO 2"). Cells(fila1, 2) = celda. Offset(0, 4). Value
Sheets("BANCO 2"). Cells(fila1, 9) = celda. Offset(0, 5). Value
Sheets("BANCO 2"). Cells(fila1, 13) = celda. Offset(0, -2). Value
Sheets("BANCO 2").Cells(fila1, 12) = celda.Value
Else
fila2 = fila2 + 1
Sheets("BANCO 1"). Cells(fila2, 3) = celda. Offset(0, -3). Value
Sheets("BANCO 1"). Cells(fila2, 5) = celda. Offset(0, 1). Value
Sheets("BANCO 1"). Cells(fila2, 6) = celda. Offset(0, 2). Value
Sheets("BANCO 1"). Cells(fila2, 2) = celda. Offset(0, 4). Value
Sheets("BANCO 1"). Cells(fila2, 9) = celda. Offset(0, 5). Value
Sheets("BANCO 1"). Cells(fila2, 13) = celda. Offset(0, -2). Value
Sheets("BANCO 1").Cells(fila2, 12) = celda.Value
End If
Next
Sheets("BANCO 1").Activate
For Each celda In Sheets("BANCO 1").Range("e7", Range("e65000").End(xlUp))
If WorksheetFunction.IsNumber(celda.Offset(0, 1)) = True Then
celda.EntireRow.Cut
Sheets("BANCO 1").Range("e65000").End(xlUp).Offset(1, -4).Select
Selection.Insert Shift:=xlDown
End If
Next
Application.ScreenUpdating = True
MsgBox "YA ESTA LISTO!!!", , "LISTO"
End Sub
pruébalas y me dices... salu2x!...
Hola de nuevo:
Estuve checando la macro y hay unas filas de depósitos que no las nota, porque las deja intercaladas.
Te envío una copia para que lo veas.
Gracias por tu paciencia y tiempo
Ya vi...
Te envío por correo al archivo solo se modifica la ultima parte para quedar así:
Sheets("BANCO 1"). Activate
For Each celda1 In Sheets("BANCO 1").Range("e7", Range("e65000").End(xlUp))
direccion = celda1.Address
line1: If WorksheetFunction.IsNumber(Range(direccion).Offset(0, 1)) = True Then
Range(direccion).EntireRow.Cut
Sheets("BANCO 1").Range("c65000").End(xlUp).Offset(1, -2).Select
Selection.Insert Shift:=xlDown
GoTo line1
End If
Next celda1
Application.ScreenUpdating = True
MsgBox "YA ESTA LISTO!!!", , "LISTO"
End Sub
Oye te aconsejo que leas lo que te explique anteriormente de los meses, pues en si este código solo te serviría para un mes no importa que te lleguen muchos envíos del mismo... pero para meses diferentes ya completos, no te los va juntar los dos solo te mostrara el resultado de uno (el que este en la hoja donde corres la macro) pues como te decía antes de correr la distribución limpia las celda en Banco1 y Banco2
me avisas que onda...
Muuuuy bueno!
Ya para finalizar, dime como le quito el signo de pesos a las cantidades. Ya intente con el formato de celdas de celdad y no lo hace. Quiero saber como los quito todos en una solo ejecución!
Gracias
Pues en el archivo que me mandaste, selecciono y le pongo formato de numero y si cambia!... se queda sin el signo de pesos
intentalo seleccionando y con click derecho dale en formato y desde ahí cambia el formato.
¿Si sigues con problemas me avisas va?... ah y con lo otro aguantame tantito
saludos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas