VBA Macro pour déplacer des cellules sur une nouvelle feuille Excel basée sur la teneur en cellule

Question

Je regarde autour de moi et je n'ai pas pu trouver la réponse spécifique dont j'ai besoin. Donc je vais demander. J'ai une feuille (feuille1) avec des données uniquement sur la colonne A. Cela ressemble à ceci:

Et j'ai besoin de créer une macro VBA qui recherche dans la colonne A pour toute cellule contenant une pièce d'identité, Titl et Auth. Et déplacez-les dans une colonne spécifique dans une autre feuille (feuille2). La feuille2 aura 3 colonnes: id, titre et auteur.

La chose est que, avec la copie des données de la cellule sur sa colonne spécifique de la feuille2, il doit également supprimer la première partie des données. Par example: ID: R564838 dans la feuille1 doit être déplacé dans la colonne ID dans la feuille2, sans "ID:" dedans. Donc, seul le R564838 devrait être déplacé. Aussi "Titl:" et "Auth:" aurait besoin d'être supprimés lors de la copie.

J'espère que cela a du sens. Je vais juste apprendre les macros VBA. Donc, je n'ai aucune idée de comment accomplir cela.

mise à jour

J'ai ce code:

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 

end sous

et ça marche. Mais il y a une authentification et titl dans la feuille1 qui sont vides. Et la situation est que lorsque cela fonctionne, il ne laisse pas une cellule vide chaque fois qu'Iut ou titl est vide. J'ai besoin de la macro pour laisser une cellule vide si auth ou titl sont en blanc afin que les informations correspondent à chaque livre. J'espère que vous comprenez mon problème.

Merci encore!

Answer 1

Définissez certaines variables pour vous assurer que vous travaillez sur le bon classeur / feuille / colonne

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

Trouver la dernière cellule de la colonne

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

Regardez chaque cellule pour déterminer quoi faire avec elle

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

Évaluez le contenu de la cellule (savoir s'il contient quelque chose de spécifique)

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

extraire le contenu de l'intérêt de la cellule (supprimer "l'en-tête")

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

Placez le contenu dans la prochaine ligne disponible de la deuxième feuille (supposant que l'ID passe dans la colonne 1)

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

Déterminez comment mettre les bits du code ensemble et l'adapter à vos besoins exacts!

---

en réponse à votre commentaire:

Fondamentalement, oui, mais vous pouvez heurter des problèmes car il n'est pas pleinement complet de votre situation particulière. Ce que vous pourriez avoir à faire est:

1. Stockez l'identifiant (une fois que vous en trouvez une) dans une variable;
2. Faites de même pour le titre et l'auteur;
3. Une fois que vous avez trouvé une ligne de délimitation, vous écrivez plutôt le contenu actuel des variables à la ligne disponible suivante et videz le contenu de ces variables.

Par exemple:

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

---

Vous allez ici :)

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 vous avez besoin d'aide pour comprendre ce que j'ai changé, faites-le-moi savoir, mais cela devrait être assez simple!

Answer 2

Vous pouvez également essayer d'essayer de faire un texte à la colonne avec un: comme séparateur.Cela donnerait à vos informations dans 2 colonnes au lieu de 1, vous pouvez ensuite rechercher une colonne pour l'en-tête et copier la valeur de la colonne suivante, vide ou autrement.