Копирование строк лисбокса

[MoHoMaXFR]

он выделяет желтым

: Sheets("счетчик(2)").Move

[MoHoMaXFR]

вот пробник

[SAS888]

А откуда берется лист "счетчик(2)"? В исходной книге его нет. Чтобы он формировался где-то в процедуре, я не увидел.
При копировании листа "счетчик", в скобках указывается номер его копии. Поэтому, для того, чтобы обратиться к нему явно, нужно в процедуре "Private Sub CommandButton5_Click()" после строки

Sheets("счетик").Copy After:=Sheets(4)

вставить строку

ActiveSheet.Name = "счетик(2)"

естественно, предварительно убедиться, что другого листа с таким именем не существует. Еще лучше - использовать другое имя (без скобок).

Например, так:

Application.DisplayAlerts = False
On Error Resume Next: Sheets("abcd").Delete: On Error GoTo 0
Sheets("счетик").Copy After:=Sheets(4)
ActiveSheet.Name = "abcd"

И, соответственно, в дальнейшем коде, при обращении к листу, использовать это имя.

[MoHoMaXFR]

так щас ещё раз ))) я хочу копировать лист счетчик. после чего вставить в него эти данные и переместить в новую книгу. тобишь в начале кнопки код

Sheets("счетик").Select
    Sheets("счетик").Copy After:=Sheets(4)

после чего вставляю данные и перемещаю

[SAS888]

Посмотрите предыдущий пост. Я там добавил пояснение.

[MoHoMaXFR]

SAS а можешь полностью код показать переделанный этой кнопки ?

Private Sub CommandButton5_Click()
    Sheets("счетик").Select
    Sheets("счетик").Copy After:=Sheets(4)
    Dim i As Integer, j As Integer, y As Range, a()
    a = x.Value: j = 18: Sheets(5).Activate
    Set y = [D:D].Find("Итого")
    If y.Row <> 19 Then Rows("18:" & y.Row - 2).Delete
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            Rows(j).Insert
            Cells(j, 1).Resize(, 6).Value = Application.Index(a, i + 1, 0)
            If j = 21 Then Exit For Else j = j + 1
    End If: Next: Sheets("счетчик(2)").Move


Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:="C:\Счета к оплате" & Format(Now, "dd_mm_yyyy_hh_nn_ss") & ".xls", FileFormat:=xlExcel8 _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    Application.DisplayAlerts = True
        ActiveWorkbook.Close (savechanges = False)
 MsgBox ("Сохранено в папке счета к оплате")
End Sub

[SAS888]

Private Sub CommandButton5_Click()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.DisplayAlerts = False
    On Error Resume Next: Sheets("счетчик_2").Delete: On Error GoTo 0
    Sheets("счетик").Copy After:=Sheets(4)
    ActiveSheet.Name = "счетчик_2"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim i As Integer, j As Integer, y As Range, a()
    a = x.Value: j = 18: Sheets(5).Activate
    Set y = [D:D].Find("Итого")
    If y.Row <> 19 Then Rows("18:" & y.Row - 2).Delete
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            Rows(j).Insert
            Cells(j, 1).Resize(, 6).Value = Application.Index(a, i + 1, 0)
            If j = 21 Then Exit For Else j = j + 1
    End If: Next: Sheets("счетчик_2").Move
    ActiveWorkbook.SaveAs Filename:="C:\Счета к оплате\" & Format(Now, "dd_mm_yyyy_hh_nn_ss") & ".xls"
    ActiveWorkbook.Close False
    MsgBox "Сохранено в папке счета к оплате"
End Sub

P.S. Я не знаю, правильное ли будет обращение к листу Sheets(5).Activate ? Корректнее обращаться по имени. Но... Если это (как и в предыдущем случае) лист, полученный копированием, то имя ему потребуется задать явно.