Ссылка на ячейку на вновь созданном листе с именем, созданным пользователем - PullRequest
1 голос
/ 23 мая 2019

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

'input box to get new user name and check if valid and create new sheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Sheets("Player Template")
    Dim newws As Worksheet, sh As Worksheet, newname
    Dim query As Long, xst As Boolean, info As String

retry:
xst = False
newname = Application.InputBox("Please Enter New players Name.", info, , , , , , 2)
If newname = "False" Then Exit Sub
For Each sh In wb.Sheets
    If sh.Name = newname Then
        xst = True: Exit For
        End If
Next
If Len(newname) = 0 Or xst = True Then
    info = "Name is invalid. Please Retry."
    GoTo retry
End If
ws.Copy after:=ws: Set newws = ActiveSheet: newws.Name = newname


Sheets("Table").Select
Range("C6").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = newname
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = 

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

1 Ответ

0 голосов
/ 23 мая 2019

Этот код копирует лист, называемый «шаблон игрока», и создает его под именем из поля ввода. Ссылки из диапазона I3: M3 копируются в следующую свободную строку в листе «таблица», столбец «C». Название листа игрока C & lastrow get и столбцы справа от имени заполнены ссылками на этот лист

Option Explicit

Sub paste_to_table()

Dim last_tblrow As Double
Dim tblwks As Worksheet, newwks As Worksheet, sh As Worksheet
Dim targetrng As Range
Dim newname As String
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Player Template")
Set tblwks = ThisWorkbook.Worksheets("Table")
Dim query As Long, xst As Boolean, info As String

retry:
xst = False
newname = Application.InputBox("Please Enter New players Name.", info, , , , , , 2)
If newname = "False" Then Exit Sub
For Each sh In wb.Sheets
    If sh.Name = newname Then
        xst = True: Exit For
        End If
Next
If Len(newname) = 0 Or xst = True Then
    info = "Name is invalid. Please Retry."
    GoTo retry
End If
ws.Copy After:=ws: Set newwks = ActiveSheet: newwks.Name = newname

'get last row of "table" column "C"
last_tblrow = tblwks.Cells(Rows.Count, "C").End(xlUp).Row

'set targetrng range variable to next empty cell of column C
Set targetrng = tblwks.Range("C" & last_tblrow + 1)
'newname value into next empty row of column C
targetrng.Value = newname
'next value into "D7" to of "table" wks from cell "I3","I4","I5".....

targetrng.Offset(0, 1).Value = "=" & newwks.Name & "!" & newwks.Cells(3, 9).Address
targetrng.Offset(0, 2).Value = "=" & newwks.Name & "!" & newwks.Cells(3, 10).Address
targetrng.Offset(0, 3).Value = "=" & newwks.Name & "!" & newwks.Cells(3, 11).Address
targetrng.Offset(0, 4).Value = "=" & newwks.Name & "!" & newwks.Cells(3, 12).Address
targetrng.Offset(0, 5).Value = "=" & newwks.Name & "!" & newwks.Cells(3, 13).Address

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...