选择特定字符串后的单元格范围并将其复制到另一个工作表答案

【问题标题】：Select and copy range of cell after a specific string to another worksheet选择特定字符串后的单元格范围并将其复制到另一个工作表
【发布时间】：2018-10-09 04:11:03
【问题描述】：

我正在使用 VBA 程序，我想复制一系列单元格，然后将其粘贴到新工作表中，标题是文本“Delivery for”后面的字符串

例如我想复制“Delivery for Sam”下的范围和名称新工作表应为“Sam”

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

【问题讨论】：

我想你的第一个运行时错误在第二行。
@jeeped 是的，这似乎是个问题，但我似乎找不到其中的错误
您的代码是一团糟，自相矛盾，尝试使用未引用的变量并且不使用它分配的变量。建议您从宏记录器重新开始。
我尝试使用宏记录器，但是将使用的范围会有所不同，因此我无法引用特定的单元格引用
N 应该是最后一行吗？如果是，那么我建议将其称为 LastRow 或 LR 或 lRow。 LastRow= Cells(Rows.Count, 1).End(xlUp).Row 其中第 1 列 = A 列。

标签： excel vba range cell

【解决方案1】：

未经测试，在移动设备上编写。可能有效，也可能无效，但可能会给您一些关于如何实现它的想法。

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

【讨论】：