我需要一个宏来搜索某列中的单元格并将所有行复制到指定的工作簿

时间:2013-01-11 17:54:28

标签: excel-vba vba excel

我正在处理一个包含数千行的电子表格,我需要在这些行中搜索以“E”开头的Col.B中的单元格,并将所有行复制到不同的工作簿。我没有找到这个具体问题的运气,或者如果我找到了什么,那就不是我需要它做的事情了。电子表格每周更新一次,我需要一个宏来执行此搜索并快速复制和粘贴,我不得不进行选择,复制和粘贴。任何帮助将不胜感激。

2 个答案:

答案 0 :(得分:1)

如果您更改了格式并使用stenci建议的数据进行了一些操作,是的,您可以避免诉诸VBA。但是,如果您处于需要保持工作表格式相同且无法按照建议操作数据的位置(例如,由于办公室官僚机构),这里有一个子程序应该做什么你在问。我确保添加大量评论来描述每一行的作用。我希望它有所帮助,祝你好运。

Sub copyRows()

Dim i As Integer, j As Integer, k As Integer
Dim bReport As Workbook, bReport2 As Workbook
Dim Report As Worksheet, Report2 As Worksheet

Set Report = Excel.ActiveSheet 'This assumes your sheet with data is the active sheet.
Set bReport = Report.Parent
Set bReport2 = Excel.Workbooks.Add 'This opens a new workbook
Set Report2 = bReport2.Worksheets(1) 'This assigns the variable for the worksheet where we will be pasting our data.

Report2.Cells(1, 1).Value = "Copied Rows" 'This gives a title to the worksheet (helps to avoid having to identify _
                                            the initial iteration of our for...next loop

For i = 1 To Report.UsedRange.Rows.Count 'Loops once for each row in the worksheet.

    If InStr(1, Left(Report.Cells(i, 2).Value, 1), "e", vbTextCompare) = 1 Then 'This searches the first letter of the value. I used the instr function to make it case-insensitive.
                                                                                    'You could also disable the binary comparison for the subroutine to accomplish this, but why bother?
        Report.Cells(i, 1).EntireRow.Copy 'This copies the row
        j = Report2.UsedRange.Rows.Count + 1 'This finds the row below the last used row in the new worksheet/workbook.
        Report2.Cells(j, 1).EntireRow.Insert (xlDown) 'This pastes the copied rows.
    End If
Next i

End Sub

注意:Siddharth Routh可能建议使用.end来查找最后使用过的单元格,而不是使用usedrange.rows.count,但我习惯于两者中的后者。一旦我对它更熟悉,我可能会开始使用前一种方法。

答案 1 :(得分:0)

如果您可以更改行的顺序,则不需要宏:
选择单元格B1,单击排序AZ按钮,选择以E开头的行,然后使用复制和粘贴。