Мой код не входит в поле на нужном листе

Question

Мой код работает нормально при создании нового листа, но следующая часть кода не работает должным образом. Я дал некоторые поля, которые должны быть введены в листе 123, но он вводит только значение «Замечания» в ячейке. А1 т.е. только последнее поле. в чем проблема?

Я не могу получить это.

Sub CreateSheet()



Dim xName As String
Dim xSht As Object
On Error Resume Next
xName = InputBox("Please enter a name for this new sheet ")
If xName = "" Then Exit Sub
    Set xSht = Sheets(xName)
    If Not xSht Is Nothing Then
        MsgBox "Sheet cannot be created as there is already a worksheet with the same name in this workbook"
        Exit Sub
        End If
        Sheets.Add(, Sheets(Sheets.Count)).Name = xName


        Sheets("New Ledger Creator").Activate


         Dim lastrow As Long
    lastrow = Range("b" & Rows.Count).End(xlUp).Row
    Range("b" & lastrow + 1).Select

    Selection = xName



Sheets("123").Select


Range("A1").Select
Selection.Value = "Paid"
Range("A2").Select

Selection.Value = "Date"
Range("B2").Select
Selection.Value = "For"
Range("C2").Select
Selection.Value = "Through"
Range("D2").Select
Selection.Value = "Amount"
Range("E2").Select
Selection.Value = "Remarks"
Range("F2").Select
Selection.Value = "Date"
Range("G2").Select
Selection.Value = "For"
Range("H2").Select
Selection.Value = "Through"
Range("I2").Select
Selection.Value = "Amount"
Range("J2").Select
Selection.Value = "Remarks"
Range("A1:E1").Select

End Sub

Answer 1

Поиграл и придумал код ниже. Показывает не использование Select и избавление от On Error Resume Next.

Option Explicit 'VERY IMPORTANT!!!!!!!!
                'Place at top of every new module by selecting Tools ~ Options and ticking
                'Require Variable Declaration.

Sub CreateSheet()

    Dim xName As String
    Dim xSht As Object
    Dim IllegalCharacters As Variant
    Dim iChr As Variant
    Dim shtNew As Worksheet
    Dim shtLCreator As Worksheet

    On Error GoTo Err_Handle

    IllegalCharacters = Array("/", "\", "[", "]", "*", "?", ":")
    xName = InputBox("Please enter a name for this new sheet.")

    'Remove any illegal characters from sheet name.
    For Each iChr In IllegalCharacters
        xName = Replace(xName, iChr, "")
    Next iChr

    If Len(xName) > 0 Then
        If WorkSheetExists(xName) Then
            MsgBox "Cannot create sheet '" & xName & "' as it already exists.", vbOKOnly + vbCritical
        Else
            Set shtNew = ThisWorkbook.Worksheets.Add
            shtNew.Name = xName

            Set shtLCreator = ThisWorkbook.Worksheets("New Ledger Creator")
            shtLCreator.Cells(Rows.Count, 2).End(xlUp).Offset(1) = xName

            With ThisWorkbook.Worksheets("123")
                .Range("A1") = "Paid"
                .Range("A2:J2") = Array("Paid", "Date", "For", "Through", "Amount", _
                                        "Remarks", "Date", "For", "Through", "Amount", "Remarks")
            End With
        End If
    End If

FAST_EXIT:

Exit Sub

Err_Handle:
    Select Case Err.Number
        Case 11 'Division by 0

            MsgBox "Somehow a division by 0 happened." & vbCr & _
                   "Well done, you did the impossible - there's no calculations in this code.", vbOKOnly

            'Resume Next 'Error was dealt with, so continue on line following error.
            'Resume 'Error was dealt with so continue on same line that caused error.
            Resume FAST_EXIT 'Error was dealt with, resume at Fast_Exit label.

        Case Else
            MsgBox Err.Description, vbOKOnly + vbCritical, Err.Number
    End Select

End Sub

'Checks if a worksheet exists - returns TRUE/FALSE
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
    Dim wrkSht As Worksheet

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    On Error Resume Next
        Set wrkSht = WrkBk.Worksheets(SheetName)
        WorkSheetExists = (Err.Number = 0)
        Set wrkSht = Nothing
    On Error GoTo 0
End Function

Answer 2

Я попробовал ваш код, и он заполнил все поля ("Оплачено", "Дата") ...

Однако, почистил немного вашего кода, это работает для вас?

Option Explicit

Sub CreateSheet()



Dim xName As String
Dim xSht As Object
On Error Resume Next
xName = InputBox("Please enter a name for this new sheet ")
If xName = "" Then Exit Sub
    Set xSht = Sheets(xName)
    If Not xSht Is Nothing Then
        MsgBox "Sheet cannot be created as there is already a worksheet with the same name in this workbook"
        Exit Sub
        End If
        Sheets.Add(, Sheets(Sheets.Count)).Name = xName


        'Sheets("New Ledger Creator").Activate


         Dim lastrow As Long
    lastrow = Range("b" & Rows.Count).End(xlUp).Row
    Range("b" & lastrow + 1).Select

    'Selection = xName



'Sheets("123").Select

With Worksheets(xName) 'I assume that all the headers will be populated in the new worksheet that has been created.
.Range("A1").Value = "Paid"
.Range("A2").Value = "Date"
.Range("B2").Value = "For"
.Range("C2").Value = "Through"
.Range("D2").Value = "Amount"
.Range("E2").Value = "Remarks"
.Range("F2").Value = "Date"
.Range("G2").Value = "For"
.Range("H2").Value = "Through"
.Range("I2").Value = "Amount"
.Range("J2").Value = "Remarks"
End With


'Range("A1:E1").Select

End Sub