Страницы: 1
RSS
Заполнение умной таблицы через ввод данных на другом листе
 
Добрый вечер!

Нужна помощь !  Нужно что бы с первого листа из ячеек ФИО и Компания заполнялись на лист два в таблицу согласно своим описанием и что бы данный в этих ячеек в котором были ведены данные становились пустыми для продолжения вода

Спасибо .
Изменено: vikttur - 25.11.2021 17:46:55
 
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        Select Case Target.Address(0, 0)
        Case "C2", "C6"
            If Range("C2").Value <> "" Then
                If Range("C6").Value <> "" Then
                    MoveData
                    Application.EnableEvents = False
                    Range("C2").MergeArea.ClearContents
                    Range("C6").MergeArea.ClearContents
                    Application.EnableEvents = True
                End If
            End If
        End Select
    End If
End Sub

Private Sub MoveData()
    With Sheets("Лист2")
        With .ListObjects(1).DataBodyRange
            With .Rows(.Rows.Count - (.Cells(.Rows.Count, 2).Value <> ""))
                .Cells(1, 2).Value = Range("C2").Value
                .Cells(1, 3).Value = Range("C6").Value
                If .Cells(1, 1).Value = "" Then
                    If IsNumeric(.Cells(1, 1).Offset(-1, 0).Value) Then
                        .Cells(1, 1).Value = .Cells(1, 1).Offset(-1, 0).Value + 1
                    Else
                        .Cells(1, 1).Value = 1
                    End If
                End If
            End With
        End With
    End With
End Sub
 
Код
Option Explicit

Sub AddInTable()

Dim tbMain As ListObject
Dim Form As Range

Set tbMain = ThisWorkbook.Worksheets("Лист2").ListObjects("Таблица1")
Set Form = ThisWorkbook.Worksheets("Лист1").Range("B1:B2")

tbMain.ListRows.Add
tbMain.DataBodyRange(tbMain.ListRows.Count, 1) = tbMain.ListRows.Count
tbMain.DataBodyRange(tbMain.ListRows.Count, 2) = Form(1, 1)
tbMain.DataBodyRange(tbMain.ListRows.Count, 3) = Form(2, 1)

Worksheets("Лист1").Range("B1:B2").Clear
End Sub
 
Заполнение  таблицена втором листе из веденых данных первого листа
Седлайте тему плиз
 
Судя по падежам, с формулировкой названия будут сложности )
Вариант названия темы
Заполнение умной таблицы через ввод данных на другом листе
 
,
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C6,C2")) Is Nothing Then
    If Range("C2") Is Nothing Then MsgBox "ÍÅ ÇÀÏÎËÍÅÍÎ ÔÈÎ": Exit Sub
    If Range("C6") Is Nothing Then MsgBox "ÍÅ ÓÊÀÇÀÍÀ ÊÎÌÏÀÍÈß": Exit Sub
    With Worksheets(2)
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(lr + 1, 1) = lr
        .Cells(lr + 1, 2) = Range("C2")
        .Cells(lr + 1, 3) = Range("C6")
    End With
End If
End Sub

Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх