Macro Excel pour copier des lignes avec un nom unique dans la colonne A dans des feuilles de nom nommés en conséquence

0

Je suis un novice Excel et apprécierais l'aide avec une macro qui fait ce qui suit.

L'utilisateur colle les données dans la feuille de saisie.

Il y a un total de 58 gènes (colonne A) avec 2 entrées pour chaque gène. L'image ne montre que 4 gènes.

Lors de l'exécution de la macro (via une touche de raccourci), l'utilisateur sera invité à entrer un numéro d'échantillon (Sample1 dans cet exemple), puis la ligne de chaque gène sera copiée-collée dans leurs feuilles respectives (déjà créées). Les gènes portent tous un nom unique. Dans chacune des feuilles de gènes, le numéro de l'échantillon doit être renseigné dans la colonne A.

Gene1

Je ne peux pas poster plus de 2 captures d'écran. Les feuilles pour les autres gènes doivent contenir les 2 rangées de ce gène avec "Sample1" dans la colonne A.

Une fois que la macro a fini de copier les lignes dans les 58 feuilles (pour les 58 gènes), elle doit revenir à la feuille d’entrée et supprimer les données précédemment collées. L'utilisateur doit être autorisé à coller les données du prochain échantillon, exécuter la macro, entrer le numéro de l'échantillon à l'invite, et les données géniques de cet échantillon sont copiées dans les deux lignes suivantes de leurs feuilles de gènes respectives.

Il existe des données pour des milliers d’échantillons à archiver, et j’espère obtenir une macro capable de le faire.

Edit: Le code maintenant (merci à Mrig) est le suivant:

Sub Macro1()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim lastRow As Long, i As Long, currLastRow
    Dim ws As Worksheet, currWS As Worksheet
    Dim SampleID As String

    SampleIDform.Show

    Set ws = ThisWorkbook.Sheets("Input")
    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To ThisWorkbook.Worksheets.Count
        Set currWS = ThisWorkbook.Sheets(i)
        currLastRow = currWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With ws.Range("A1", "D" & lastRow)
            .AutoFilter Field:=1, Criteria1:=currWS.Name
            .Offset(1, 0).Copy currWS.Range("A" & currLastRow)
            .AutoFilter
            Range("A" & currLastRow).Value = SampleID
        End With
    Next i

    ws.Range("A2", "D" & lastRow).ClearContents

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Private Sub OkButton_Click()
    SampleID = txtSampleID.Value
    Unload Me
End Sub

J'ai ajouté la ligne Range("A" & currLastRow).Value = SampleIDà la boucle with, mais je ne parviens pas à obtenir le SampleID inclus avec chaque feuille de la colonne A.

Qu'est-ce que je fais mal?

Ramani
la source
1
Bienvenue sur Super User. Les nouveaux membres confondent généralement cela avec un site de service où nous ferons le travail. C'est une communauté de questions-réponses où des questions spécifiques sont posées après que vous ayez tenté quelque chose et que vous soyez bloqué. Veuillez ajouter des détails sur ce que vous avez essayé jusqu’à présent, y compris des scripts, du code ou des formules, et nous essaierons de vous aider. Si vous avez besoin de plus d’informations pour poser des questions, consultez la rubrique Comment poser des questions dans le centre d’aide .
CharlieRB
J'avais commencé à ajouter 58 noms de feuille de calcul aux critères de filtre automatique après la réponse affichée par l'utilisateur 2140261 dans ce lien lorsque Mrig avait posté la réponse ci-dessous, et m'avait évité le problème. :-)
Ramani

Réponses:

0

Cela devrait faire pour vous:

Hypothèses:
1. La feuille de saisie est votre première feuille de calcul dans le classeur que vous travaillez
2. Toutes les feuilles ont un en-tête.Gene | Allele | Reads | Sequence

Sub DataToSheets()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Dim lastRow As Long, i As Long, currLastRow
    Dim ws As Worksheet, currWS As Worksheet

    Set ws = ThisWorkbook.Sheets("Input")
    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To ThisWorkbook.Worksheets.Count
        Set currWS = ThisWorkbook.Sheets(i)
        currLastRow = currWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With ws.Range("A1", "D" & lastRow)
            .AutoFilter Field:=1, Criteria1:=currWS.Name
            .Offset(1, 0).Copy currWS.Range("A" & currLastRow)
            .AutoFilter
        End With
    Next i

    ws.Range("A2", "D" & lastRow).ClearContents

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Quelques changements ont été apportés à la réponse donnée par @ user2140261 dans le lien mentionné par @Sun dans les commentaires.

Mrig
la source
Merci pour le code court et efficace. Il fonctionne très bien!
Ramani
J'essaie maintenant de capturer l'ID d'échantillon comme entrée de l'utilisateur. J'ai créé un formulaire utilisateur "SampleIDform", avec une zone de texte "txtSampleID" et un bouton Ok avec la commande suivante: Private Sub OkButton_Click () SampleID = txtSampleID.Text Unload Me End Sub
Ramani
@ Ramani - Je suppose que j'ai donné une réponse à votre question initiale, si cela répond à votre exigence, veuillez l'accepter avec bonté. Pour toute autre question non liée à la réponse ci-dessus, vous devez poser une autre question.
Mrig
et dans le module principal, ont inséré les lignes suivantes: Dim SampleID As String SampleIDform.Show et dans la boucle With, j'ai ajouté la ligne suivante: Range ("A" & currLastRow) .Value = SampleID avec l'intention d'ajouter SampleID à chaque ligne créée dans toutes les feuilles. Lorsque j'exécute la macro, le formulaire utilisateur s'affiche et s'exécute lorsque je clique sur le bouton Ok, mais le SampleID n'est pas entré dans la colonne A des feuilles de gènes séparées. Qu'est-ce que je fais mal? Merci!
Ramani
@Ramani - Vous devrez utiliser SampleID = txtSampleID.Value '
Mrig
0

Merci Mrig pour toute votre contribution. Je pense avoir résolu mes problèmes. Mon code est le suivant:

Sub DataToSheets()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim lastRow As Long, i As Long, currLastRow
    Dim ws As Worksheet, currWS As Worksheet
    Dim SampleID As String

    Set ws = ThisWorkbook.Sheets("Input")
    lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

    SampleID = InputBox("Key in Sample ID", "Sample ID")
    If (StrPtr(SampleID) = 0) Then
        MsgBox "You pressed cancel or [X]"
    ElseIf (SampleID = "") Then
        MsgBox "You did not enter anything"
    Else
    For i = 2 To ThisWorkbook.Worksheets.Count
        Set currWS = ThisWorkbook.Sheets(i)
        currLastRow = currWS.Cells(Rows.Count, "A").End(xlUp).Row + 1
        With ws.Range("A1", "D" & lastRow)
            .AutoFilter Field:=1, Criteria1:=currWS.Name
            .Offset(1, 0).Copy currWS.Range("A" & currLastRow)
            .AutoFilter
            currWS.Range("A" & currLastRow).Value = SampleID
            currWS.Range("A" & currLastRow + 1).Value = SampleID
        End With
    Next i
    End If
    ws.Range("A2", "D2" & lastRow).ClearContents

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub PasteValues()
'
' PasteValues Macro
'
' Keyboard Shortcut: Ctrl+r
'    
    On Error Resume Next

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    Call DataToSheets

End Sub

Je ne pouvais pas obtenir la contribution du formulaire utilisateur reconnue pour une raison quelconque et je me suis donc tourné vers la méthode InputBox pour obtenir la saisie de l'utilisateur. Les lignes currWS.Range("A" & currLastRow).Value = SampleIDet currWS.Range("A" & currLastRow + 1).Value = SampleIDincluent le SampleID saisi dans la colonne A des 2 lignes copiées à partir de la feuille d’entrée, pour chaque feuille de gène. S'il y a un moyen plus efficace de le faire, s'il vous plaît faites le moi savoir.

Il suffit à l’utilisateur de faire copier les données, d’ouvrir le fichier Excel, d’exécuter le raccourci clavier, puis de saisir le SampleID dans le InputBox.

Merci à tous, spécialement Mrig !!

Ramani
la source
Génial! Heureux de vous voir apporter des modifications au code selon vos besoins.
Mrig