Выделите и скопируйте диапазон ячейки после определенной строки на другой лист - PullRequest
Новая
       18

Выделите и скопируйте диапазон ячейки после определенной строки на другой лист

0 голосов
/ 09 октября 2018

Я работаю с программой VBA и хочу скопировать диапазон ячеек, а затем вставить в него новый лист с заголовком, являющимся строкой, следующей за текстом «Доставка за»

Например, я хочудиапазон копий в разделе «Доставка для Сэма» и название новой рабочей таблицы должно быть «Сэм» 

Dim N as long
N = Range(Cells(rcell, Col_Western).End(xlDown).Row)

With ActiveSheet
    For rcell = 1 To lastrow
        If InStr(1, Cells(rcell, Col_Western), "Delivery for", vbBinaryCompare) > 0 Then
            Range(ActiveCell & N).Select
            Selection.Copy After:=Worksheets(Sheets.Count)
            ActiveSheet.Name = "QBS"
        End If
    Next rcell
End With

1 Ответ

0 голосов
/ 09 октября 2018

Не проверено, написано на мобильном телефоне.Может сработать, может и нет, но может дать вам некоторое представление о том, как этого добиться. 

Option Explicit

Sub test()

Dim sourceSheet as worksheet
'Change this to the name of the sheet which contains the data you want to separate by name. I assume Sheet1'
Set sourceSheet = Thisworkbook.worksheets("Sheet1")

With sourceSheet

Dim westernColumn as long
' If this can change (based on the location of the data), you need to work out some logic to assign it dynamically. If this does not change, turn it into a constant and assign to whatever column number it should be. I arbitrarily pick column 5 (column E) as an example '
westernColumn = 5

Dim lastRow as long
lastRow = .cells(.rows.count, westernColumn).end(xlup).row

End with

Dim rowIndex as long
Dim deliveryName as string
Dim characterIndex as long

For rowIndex = 1 to lastRow

characterIndex = InStr(1, sourcesheet.Cells(rowIndex, westernColumn).value2, "Delivery for ", vbBinaryCompare)

If characterIndex > 0 Then

deliveryName = VBA.strings.mid$(sourcesheet.Cells(rowIndex, westernColumn).value2, characterindex + 13) '+13 is a magic number used to exclude "Delivery for " string itself, implement it in a better way if possible'

With thisworkbook.worksheets.add
' this line below might cause an error if a sheet with this name already exists or if deliveryName is illegal in some way. Maybe code some defensive checks before assigning sheet name.
.name = deliveryName

' This includes the "Delivery for " row when copy-pasting  and assumes each there is a blank row before each "Delivery for " row. '
sourceSheet.range(sourcesheet.Cells(rowIndex, westernColumn), sourcesheet.Cells(rowIndex, westernColumn).end(xldown)).copy .range("A1")

End with

End if

' you should probably have two variables: startRow and endRow, where startRow = first "Delivery for ", and endRow = next "Delivery for "

' but I don't have time to do this at the moment.'

Next rowIndex ' should increment rowIndex by number of rows pasted - 1, so that pasted rows are not needlessly checked for "Delivery for " string '

End sub
...