Страницы: 1
RSS
Перенос данных и автоматическое обновление ListBox, правка макрос переноса данных
 
Доброго дня ! Подскажите пожалуйста что нужно подправить в макросе, чтоб скопированную информацию , начинал вставлять в перенесённом листе не со второй строки а например с десятой.
Заранее благодарю!
Private Sub CommandButton1_Click()
Dim li As Long, lLastRow As Long, sShName As String, avArr() As Long
Select Case True
Case OptionButton1: sShName = OptionButton1.Caption
Case OptionButton2: sShName = OptionButton2.Caption
Case OptionButton3: sShName = OptionButton3.Caption
End Select
If sShName = "" Then Exit Sub
Application.ScreenUpdating = 0
ReDim avArr(0)
With Sheets(sShName)
For li = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(li) Then
avArr(UBound(avArr)) = li + 2
ReDim Preserve avArr(UBound(avArr) + 1)
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Rows(li + 2).Copy .Rows(lLastRow)
End If
Next li
End With
For li = UBound(avArr) To LBound(avArr) Step -1
If avArr(li) > 0 Then Rows(avArr(li)).Delete
Next li
Application.ScreenUpdating = 1
End Sub

макрос взят от сюда:
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=22585
 
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 8
 
не ,не подходит, при таком раскладе lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 8 он конечно начинает вставлять с 9 строки но к сожалению все последующие скопированные строки вставляет с промежутком в 7 строк а надо чтоб шли подряд
 
if .Cells(.Rows.Count, 1).End(xlUp).Row=1 then
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row +8
else
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
end if
 
ругается Next without for
Страницы: 1
Наверх