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

[MoHoMaXFR]

Доброго времени суток. Проблема такая : есть лист бокс со значение fmmultiselectmulti . Необходимо сделать так чтобы выделенные значения попадали в Таблицу бланка на следующем листе . При это необходимо чтобы коллво элементов таблицы помещённых в бланк могло увеличиваться и сокращаться автоматически. Тоесть Ячейка итого перемещалась ниже выше.

В инете ничего умного не нашел или я не вижу.

[MoHoMaXFR]

немного не правильно сказал. Строк 4 максимум. как ограничить этот максимум ещё?

[MoHoMaXFR]

Народ просто скажите как тогда обозвать все выделения))) с одним проще)) у одного listindex потом распихал по текстбоксам и всё а как сделать когда их много?

[SAS888]

Посмотрите пример во вложении.
Если в ListBox выбрать более 4-х значений, то в таблицу будут помещены первые 4.

[MoHoMaXFR]

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

почему не выполняется код после End if: Next

[MoHoMaXFR]

то есть лист не перемещается и не сохраняется по указанному пути

[SAS888]

почему не выполняется код после End if: Next

Что значит "не выполняется код"? Выдается ошибка? Какая? Или просто не создается файл?
Проверьте правильность задания пути и имени файла. Если Вы хотите сохранить файл в папку "C:\Счета к оплате", то строка пути должна формироваться так:

ActiveWorkbook.SaveAs Filename:="C:\Счета к оплате\" & Format(Now, "dd_mm_yyyy_hh_nn_ss") & ".xls"

[MoHoMaXFR]

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

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

[MoHoMaXFR]

это уже поправил ="C:\Счета к оплате\"

[SAS888]

Проверил в 2003 и 2007. Указанный лист перемещается и книга сохраняется по указанному пути.
Попробуйте в новой книге выполнить макрос

Sub qq()
    Sheets("Лист1").Move: Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\Счета к оплате\" & Format(Now, "dd_mm_yyyy_hh_nn_ss") & ".xls"
    Application.DisplayAlerts = True: ActiveWorkbook.Close False
End Sub

Если все будет работать правильно, то похоже, что для решения Вашей проблемы, без примера файла не обойтись.