Замена первой записи на вновь созданную запись вместо созданной новой строки в листе Excell

Question

У меня есть 4 листа Название Создание проекта, Ашок, Мастер и Лист Главная

Лист Содержит сведения о проекте вместе с данными, и некоторые данные столбцов будут скопированы на лист проекта в это время структура проекта (имена заголовков и дизайн с объединенными строками) и загрузят данные нескольких столбцов из основного листа, если я вставлю новый строка в главном листе должна обновлять лист проекта с несколькими данными столбцов, но с использованием дочерней структуры листа (Пустой шаблон дизайна).

Я реализовал следующий код, проблема в том, что каждый раз, когда он заменяет первую запись (это объединенные строки), я имею в виду, если вставить вторую строку, она заменяет.

Пожалуйста, помогите мне и отправьте изображения

Private Sub CopyDataFrmExcell()
Dim xRCount As Long
    Dim xSht As Worksheet
     Dim ws As Worksheet
    Dim xNSht As Worksheet

  Dim lrs As Long, lrd As Long, p As Long, brd As Long, krd As Long, LastRowNumber As Long

lrs = Sheets("ProjectCreation").Cells(Sheets("ProjectCreation").Rows.Count, 1).End(xlUp).Row
With Sheets("Ashok")  'longer to type than "Summary"
    For p = 2 To lrs 'assumes header in row 1

        If p = 2 Then
            lrd = .Cells(.Rows.Count, 1).End(xlUp).Row
           Sheets("Ashok").Cells(5, 7).Value = Sheets("ProjectCreation").Cells(p, 9).Value
            brd = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(5, 8).Value = Sheets("ProjectCreation").Cells(p, 10).Value
            krd = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Cells(5, 9).Value = Sheets("ProjectCreation").Cells(p, 11).Value

           Else
           Sheets("Sheet4").Select
            Sheets("Sheet4").Range("A1:Y6").Copy Destination:=Sheets("Ashok").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
           Sheets("Ashok").Select
           LastRowNumber = Sheets("Ashok").Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row     
          lrd = .Cells(.Rows.Count, 1).End(xlUp).Row
         Sheets("Ashok").Cells(LastRowNumber + 1, 7).Value = Sheets("ProjectCreation").Cells(p, 9).Value
          brd = .Cells(.Rows.Count, 6).End(xlUp).Row
          .Cells(LastRowNumber + 1, 8).Value = Sheets("ProjectCreation").Cells(p, 10).Value
           krd = .Cells(.Rows.Count, 6).End(xlUp).Row
        .Cells(LastRowNumber + 1, 9).Value = Sheets("ProjectCreation").Cells(p, 11).Value    
        End If
Next p
End With
End Sub

Answer 1

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

Private Sub CopyDataFrmExcell()

    Dim WsPro As Worksheet
    Dim WsSum As Worksheet
    Dim Ws4 As Worksheet
    Dim R As Long
    Dim RlPro As Long, RlSum As Long

    Set WsPro = Worksheets("ProjectCreation")
    Set WsSum = Worksheets("Ashok")                 'longer to type than "Summary"
    Set Ws4 = Worksheets("Sheet4")

    With WsPro
        RlPro = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    With WsSum
        For R = 2 To RlPro                          'assumes header in row 1
            If R = 2 Then
                WsPro.Range("I2:K2").Copy .Cells(5, 7)
            Else
                Ws4.Range("A1:Y6").Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                RlSum = .Cells(.Rows.Count, 1).End(xlUp).Row
                WsPro.Range(Cells(R, 9), Cells(R, 11)).Copy .Cells(RlSum + 1, 7)
            End If
        Next R
    End With
End Sub

Как видите, я попытался дать несколько значимых имен переменным. Теперь вы сможете идентифицировать их по их именам. Это, в свою очередь, позволяет прочитать описание кода, которое все еще не имеет смысла.

Ядро кода проходит по каждой строке в WsPro и затем что-то делает в WsSum. Это кажется нелогичным. Хорошо, вы хотите скопировать заголовок из WsPro в WsSum. Это действительно не должно быть в цикле, не так ли? Затем вы хотите скопировать диапазон Ws4.Range ("A1: Y6") в конец WsSum. Справедливо, но почему это нужно делать несколько раз в зависимости от количества строк в WsPro? Наконец, вы хотите вставить каждую строку WsPro в конец WsSum, следуя диапазону от Ws4. Возможно, Ws4 не всегда должен быть одним и тем же листом.

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