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

Question

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

Вот код, над которым я работал для входа:

Option Explicit

Function GetUserName() As String
    GetUserName = ThisWorkbook.Sheets("Login").Range("userName").Value
End Function

Function GetPassword() As String
    GetPassword = ThisWorkbook.Sheets("Login").Range("passWord").Value
End Function

Function IsValidUser(u As String, p As String) As Boolean
    Dim vu As Variant
    Set vu = ThisWorkbook.Sheets("Admin").Range("listOfUsers").Find(u)
    If Not vu Is Nothing And ThisWorkbook.Sheets("Admin").Cells(vu.Row, 
vu.Column + 1).Value = p Then IsValidUser = True Else IsValidUser = False
    Set vu = Nothing
End Function

Function IsLockedUser(u As String) As Boolean
    Dim vu As Variant
    Set vu = ThisWorkbook.Sheets("Admin").Range("listOfUsers").Find(u)
    If Not vu Is Nothing And ThisWorkbook.Sheets("Admin").Cells(vu.Row, 
vu.Column + 2).Value = 0 Then IsLockedUser = True Else IsLockedUser = False
    Set vu = Nothing
End Function

Function GetNoOfAttempt() As Integer
    GetNoOfAttempt = ThisWorkbook.Sheets("Login").Range("noOfAttempt").Value
End Function

Sub SetNoOfAttempt(a As Integer)
    ThisWorkbook.Sheets("Login").Range("noOfAttempt").Value = a
End Sub

Sub Login()
    On Error GoTo err
    Dim totAttempt As Integer
    totAttempt = GetNoOfAttempt

    If IsValidUser(GetUserName, GetPassword) Then
        If IsLockedUser(GetUserName) = False Then
        ThisWorkbook.Sheets("Input").Activate
    Else
        LockUser GetUserName
        MsgBox GetMessage("userLocked"), vbExclamation, "Locked"
    End If
Else
    SetNoOfAttempt totAttempt - 1
    If GetNoOfAttempt > 0 Then
        MsgBox GetMessage("msgLoginFailed"), vbExclamation, "Failed"
    Else
        MsgBox GetMessage("maxAttempt"), vbExclamation, "Failed"
    End If
End If
Exit Sub
err:
MsgBox err.Description, vbExclamation, "Error"
End Sub


Sub LockUser(u As String)
Dim vu As Variant
Set vu = ThisWorkbook.Sheets("Admin").Range("listOfUsers").Find(u)
If Not vu Is Nothing Then ThisWorkbook.Sheets("Admin").Cells(vu.Row, vu.Column + 2).Value = 0
Set vu = Nothing
End Sub

Вот листы, которые я использую:

Лист данных

Таблица назначения

Цель этого обновления.Поэтому, если пользователь хочет что-то изменить в своих данных, он может легко обновить его в листе назначения.тогда кнопка сохранения должна автоматически обновить свои данные в техпаспорте.

Answer 1

Мне удалось добиться результата, который я хочу.Я просто создал новый лист, затем получил данные из таблицы данных, равной имени пользователя, который вошел в систему. Затем вставьте новый лист.После этого я просто равняю ячейки с нового листа на лист назначения.

Администратор = Лист данных

Профиль = Лист назначения

Консолидированный = Новый лист

Вот код:

Sub Transfer_Consolidated()

path = "Admin"

sql = ""
sql = sql & "Select [Username], [Password], '', [Security Question 1], 
[Answer 1], [Security Question 2], [Answer 2], [Security Question 3], 
[Answer 
3]"
sql = sql & "From [Admin$C26:K54]"
sql = sql & "Where [Username] = '" & Sheet1.Range("userName").Value & "'"

Sheet = "Consolidated" '(New Sheet)

LastRow = ThisWorkbook.Sheets("Admin").Range("A" & Rows.Count).End(xlUp).Row

Scrape path, sql, Sheet

Call Transfer_Profile

End Sub

Sub Transfer_Profile()


 Sheets("Profile").Range("E14").Value = _
 "=Consolidated!B2"

 Sheets("Profile").Range("E17").Value = _
 "=Consolidated!D2"

 Sheets("Profile").Range("E18").Value = _
 "=Consolidated!E2"

 Sheets("Profile").Range("E19").Value = _
 "=Consolidated!F2"

 Sheets("Profile").Range("E20").Value = _
 "=Consolidated!G2"

 Sheets("Profile").Range("E21").Value = _
 "=Consolidated!H2" '

 Sheets("Profile").Range("E21").Value = _
 "=Consolidated!H2"

 Sheets("Profile").Range("E22").Value = _
 "=Consolidated!I2"


End Sub