Macro de VBA para mover las celdas a una nueva hoja de Excel en función del contenido celular

Question

Miro alrededor y no pude encontrar la respuesta específica que necesito. Así que lo preguntaré. Tengo una hoja (hoja 1) con datos solo en la columna A. Se ve así:

Y necesito crear una macro VBA que busca en la columna A para cualquier célula que contenga ID, TITL y AUTH. Y moverlos a una columna específica en otra hoja (hoja2). Sheet2 tendrá 3 columnas: ID, Título y autor.

La cosa es que junto con copiar los datos de la celda a su columna específica en la hoja2, también necesita eliminar la primera parte de los datos. Por ejemplo: ID: R564838 en hoja 1 debe moverse a la columna ID en hoja2, sin la "ID:" en ella. Así que solo la R564838 tendría que ser movido. También "Titl:" y "Auth:" tendría que ser eliminado cuando se copiera.

Espero que esto tenga sentido. Solo estoy aprendiendo a VBA Macros. Así que no tengo idea de cómo lograr esto.

actualización

Tengo este código:

Sub MoveOver() 

Cells(1, 1).Activate 


While Not ActiveCell = "" 

    If UCase(Left(ActiveCell, 4)) = "  ID" Then Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move ID to Col A in sheet 2

    If UCase(Left(ActiveCell, 4)) = "TITL" Then Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move TITL to Col B in sheet 2

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then Sheets(2).Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _ 
    Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move AUTH to Col C in sheet 2

    ActiveCell.Offset(1, 0).Activate 

Wend 

Subs secundario

y funciona. Pero hay algunos autentic y titl en hoja 1 que están en blanco. Y la situación es que cuando se ejecuta, no deja una celda vacía cada vez que AUTH O TITL estén en blanco. Necesito la macro para dejar una celda vacía si Auth o Titl están en blanco, por lo que la información coincide con cada libro. Espero que entiendas mi problema.

¡Gracias de nuevo!

Answer 1

Establecer algunas variables para asegurarse de que está trabajando en el libro de trabajo / hoja / columna derecha

Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
col = 1

Encuentra la última celda de la columna

last1 = ws1.Cells(ws1.Rows.Count, col).End(xlUp).Row

Mira cada celda para averiguar qué hacer con él

For x = 1 To last1
    'What you do with each cell goes here
Next x

Evaluar el contenido de la celda (saber si contiene algo específico)

If ws1.Cells(x, col) Like "*ID:*" Then
    'What you do with a cell that has "ID:" in it
End If

Extrae el contenido de interés de la celda (elimine el encabezado ")

myID = Mid(ws1.Cells(x, col), InStr(ws1.Cells(x, col), "ID:") + Len("ID:"))

Coloque el contenido en la siguiente fila disponible de la segunda hoja (asumiendo ID va en la columna 1)

current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID

¡Averigua cómo juntar los bits de código y adaptarlo a sus necesidades exactas!

---

en respuesta a su comentario:

Básicamente, sí, pero puede tener algún problema ya que no está completamente integral de su situación particular. Lo que podría tener que hacer es:

1. almacena la identificación (una vez que encuentre uno) en una variable;
2. hacer lo mismo para el título y autor;
3. Una vez que encuentre una línea de delimitación, en su lugar, escriba el contenido actual de las variables a la siguiente línea disponible y vacíe el contenido de esas variables.

Por ejemplo:

If ws1.cells(x, col) Like "*----*" Then
    current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
    ws2.Cells(current2, 1) = myID
    ws2.Cells(current2, 2) = myTitle
    ws2.Cells(current2, 3) = myAuthor
    myID = ""
    myTitle = ""
    myAuthor = ""
End If

---

Aquí vas :)

Sub MoveOver() 

Cells(1, 1).Activate 

myId = ""
myTitle = ""
myAuthor = ""

While Not ActiveCell = ""

    If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

    If ActiveCell Like "*---*" Then
        'NOW, MOVE TO SHEET2!
        toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        Sheets(2).Cells(toRow, 1) = myId
        Sheets(2).Cells(toRow, 2) = myTitle
        Sheets(2).Cells(toRow, 3) = myAuthor
        myId = ""
        myTitle = ""
        myAuthor = ""
    End If

    ActiveCell.Offset(1, 0).Activate

Wend

Si necesita ayuda para comprender lo que cambié, avíseme, ¡pero debería ser bastante directo!

Answer 2

Es posible que también quiera intentar hacer un texto en columna con A: como separador.Eso le daría su información en 2 columnas en lugar de 1, entonces podría buscar una columna para el encabezado y copiar el valor de la siguiente columna, en blanco o de otra manera.