Макрос Excel для копирования строк с уникальным именем в столбце A в соответствующие имена Wosksheets

Question

Я новичок в Excel, и был бы признателен за помощь с макросом, который делает следующее.

Всего имеется 58 генов (столбец A) с 2 записями для каждого гена. Изображение показывает только 4 гена.

После запуска макроса (с помощью сочетания клавиш) пользователю будет предложено ввести номер образца (в данном примере Sample1), а затем строка для каждого гена должна быть скопирована в соответствующие листы (уже созданы). Все гены имеют уникальные имена. В каждом из генных листов номер пробы должен быть заполнен в столбце А.

Я не могу опубликовать более 2 скриншотов. Листы для других генов должны содержать 2 строки для этого гена с "Sample1" в столбце A.

Как только макрос завершит копирование строк на 58 листов (для 58 генов), он должен вернуться на лист ввода и удалить ранее вставленные данные. Пользователь должен иметь возможность вставлять данные для следующего образца, запускать макрос, вводить номер образца, когда будет предложено, и данные гена для этого образца копируются в следующие 2 строки их соответствующих листов гена.

Есть данные для тысяч сэмплов для базы данных, и я надеюсь получить макрос, который сможет это сделать.

Изменить: код сейчас (спасибо Мриг) следующим образом:

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

Я добавил в строку Range("A" & currLastRow).Value = SampleID для цикла with, но я не могу включить SampleID в каждый лист в столбце A.

Что я делаю неправильно?

Answer 1

Это должно сделать для вас:

Предположения:
1. Лист ввода - ваш первый рабочий лист в рабочей книге, с которой вы работаете
2. Все листы имеют заголовок 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

Внесены некоторые изменения в ответ, данный @ user2140261 по ссылке, указанной @Sun в комментариях.

Answer 2

Спасибо, Мриг, за ваш вклад. Я думаю, что я решил свои проблемы. Мой код выглядит следующим образом:

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

Я не мог получить ввод от пользовательской формы, распознаваемой по какой-то причине, и поэтому прибег к использованию InputBox для получения пользовательского ввода. Линии currWS.Range("A" & currLastRow).Value = SampleID и currWS.Range("A" & currLastRow + 1).Value = SampleID включает введенный SampleID в столбце A из 2 строк, скопированных из листа ввода, для каждого генного листа. Если есть более эффективный способ сделать это, пожалуйста, дайте мне знать.

Все, что нужно сделать пользователю, это скопировать данные, открыть файл Excel, запустить клавишу быстрого доступа, а затем ввести SampleID в InputBox.

Спасибо всем, особенно Мриг !!