Necesito hacer una macro que copie datos segun condición y los pegue a otra hojas
Necesito Hacer una macro que me copie los datos de la columna "Proyectos" de la Hoja "tabla proyectos)" Si estos pertenecen según corresponda los datos de la columna "Status" ejemplo que me copie los datos de la columna Proyectos que corresponden a Idea.
Luego pegue esos datos a la Hoja llamada ideas en carpeta en la columna "C" desde la celda C3 en adelante de esta hoja.
Luego en la hoja "Tabla Proyectos" vuela a copiar los datos de la columna "D" pero solo si correspondes a Idea priorizada y me los pegue en la Hoja de ideas priorizadas en la columna C, desde la la celda C3 en adelante
Luego en la hoja "Tabla Proyectos" vuela a copiar los datos de la columna "D" pero solo si correspondes a Diseño y me los pegue en la Hoja de P. Diseño en la columna C, desde la la celda C3 en adelante.
Luego en la hoja "Tabla Proyectos" vuela a copiar los datos de la columna "D" pero solo si correspondes a Ejecución y me los pegue en la Hoja de P.Ejecucion en la columna C, desde la la celda C3 en adelante.
Luego en la hoja "Tabla Proyectos" vuela a copiar los datos de la columna "D" pero solo si correspondes a Terminados y me los pegue en la Hoja de P. Terminados en la columna C, desde la la celda C2 en adelante.
Luego en la hoja "Tabla Proyectos" vuela a copiar los datos de la columna "D" pero solo si correspondes a Eliminados y me los pegue en la Hoja de P. Eliminados en la columna C, desde la la celda C3 en adelante.
fin.
2 Respuestas
Sustituye la macro anterior por esta.
Sub CopiarStatus()
'Por.Dante Amor
Set h1 = Sheets("tabla proyectos")
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
Select Case UCase(h1.Cells(i, "A"))
Case "IDEA": h = "ideas en carpeta"
Case "IDEA PRIORIZADA": h = "ideas priorizadas"
Case "DISEÑO": h = "p. diseño"
Case "EJECUCION": h = "p. ejecucion"
Case "TERMINADO": h = "p. terminados"
Case "ELIMINADO": h = "p.eliminados"
Case Else: h = ""
End Select
If h <> "" Then
Set h2 = Sheets(h)
u = h2.Range("C" & Rows.Count).End(xlUp).Row + 1
If u < 3 Then u = 3
h2.Cells(u, "C") = h1.Cells(i, "D")
End If
Next
MsgBox "Terminado"
End SubSaludos.Dante Amor.
Muchas gracias, me copia todo super bien, pero si la celda tiene datos no me los sustituye. si no que me los copia abajo =(
Utiliza esta macro:
Sub CopiarStatus()
'Por.Dante Amor
Set h1 = Sheets("tabla proyectos")
hojas = Array("ideas en carpeta", "ideas priorizadas", "p. diseño", "p. ejecucion", "p. terminados", "p.eliminados")
For i = LBound(hojas) To UBound(hojas)
hoja = hojas(i)
Set h2 = Sheets(hoja)
u = h2.Range("C" & Rows.Count).End(xlUp).Row + 1
If u < 3 Then u = 3
h2.Range("C3:C" & u).ClearContents
Next
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
Select Case UCase(h1.Cells(i, "A"))
Case "IDEA": h = "ideas en carpeta"
Case "IDEA PRIORIZADA": h = "ideas priorizadas"
Case "DISEÑO": h = "p. diseño"
Case "EJECUCION": h = "p. ejecucion"
Case "TERMINADO": h = "p. terminados"
Case "ELIMINADO": h = "p.eliminados"
Case Else: h = ""
End Select
If h <> "" Then
Set h2 = Sheets(h)
u = h2.Range("C" & Rows.Count).End(xlUp).Row + 1
If u < 3 Then u = 3
h2.Cells(u, "C") = h1.Cells(i, "D")
End If
Next
MsgBox "Terminado"
End Sub
sale error "1004" =(
Presiona el botón que dice depurar y dime en cuál línea de la macro se pone de amarillo.
Revisa en esta línea de la macro los nombres correspondan a los nombres de tus hojas
Hojas = Array("ideas en carpeta", "ideas priorizadas", "p. diseño", "p. ejecucion", "p. terminados", "p.eliminados")Revisa bien los espacios entre palabras, al inicio y al final de cada nombre de hoja.
Son los mismos :(
Presiona el botón que dice depurar y dime en cuál línea de la macro se pone de amarillo.
Cambia en la macro esto:
H2.Range("C3:C" & u). ClearContentsPor esto:
H2. Range("C3:C" & u) = ""Si aparece nuevamente el error, presiona depurar, acerca el puntero del mouse a la letra u, te debe aparecer un mensaje con el valor de u, ejemplo:
Y me envías la pantalla
En el link tienes un ejemplo
http://www.programarexcel.com/2014/09/recorre-columna-y-copia-datos-en.html
En http://programarexcel.com/p/home.html encontraras cientos de macros de ejemplo para descargar gratuitamente