根据列中的条件复制一系列行并粘贴到名为条件的其他表中
在Excel 2010中，我需要一些帮助来编写macros。
我需要知道如何根据一列中的条件复制特定范围的行，并将包含该指定条件的每一行（整行，所有其他字段）粘贴到其对应的表格中（下面更详细地解释）。 困难的部分是这些“目的地”表可能已经有一些数据，需要留在那里，不要被删除。 那么，我怎样才能写一个macros来做我刚才所描述的，但是当它粘贴时，它会find第一个空行来开始粘贴。
我有一个约5张工作簿。 第一张纸是包含所有数据的ALL纸张。 接下来的4张纸被命名为Tree ， Graffiti ， Light Pothole 。 所有5个表中的所有字段都是相同的。 在每一张纸上，都有一个叫做Type Of Service字段，它是这四种服务之一（ tree ， graffiti ， light或pothole ）。
我需要做的是过滤这4个服务（每次一个）的ALL表单，select所有的字段和包含指定服务的所有行，全部复制，然后粘贴到它的单个工作表。 这些单独的工作表可能包含一些数据，所以粘贴需要find第一个空行，并粘贴在那里。 按原样连接工作表和ALL工作表的复制行。 我需要macros来做所有4个服务filter/粘贴在一起。
你可以通过录制一个macros观来理解一切。 有一个额外的知识和平，而不是说“A1：G3”你可以使用范围（单元格（x，y），单元格（x，y）），并举例
Range( Cells(1,1), Cells(1,3).Select ActiveSelection.Copy ' or .Cut
转到Excel选项并在常规选项卡上selectUSE R1C1样式。 Excel也显示列上的数字。
空细胞被发现
IsEmpty( Cells(3,9) )
打开现有的工作表使用
Sheets("All").Select
所以
dim currentService currentService = Cells(i, 3) ' current row, 13'th column Sheets(currentService).Select
所以它是这样的：要么find过滤function，然后通过moveDown遍历单元格。
可能最简单的方法是按服务sorting每个服务的开始和结束行，通过在线迭代直到到达别的东西（这不是空的）复制每个服务的整个范围select正确的书为该服务，find空行该服务表（通过读取每行的单元格，或者如果你想检查一些单元格：
Function hasRowContent (rownum as Integer) as Boolean Dim rowContentCheck rowContentCheck = Cells(rownnum, 1) & Cells(rownum, 3) & Cells(rownnum, 7) hasRowContent = rowContentCheck <> "" Return End Function
计算空行的数量。 没有内容的每一行都会增加emptyRows计数器
emptyRows = emptyRows + 1
您遇到的每一行内容都将emptyRows设置为零，并从此处开始计数。
If emptyRows > emptyRowsToStopAt rowInServiceSheet = currentRow
代码的开始…
dim emptyRowsToStop dim emptyRows For currentRow = 1 To 1000
编辑：
所有代码在我的第一个答案解释
开始：
Public Function SheetExists(sheetName As String) As Boolean ' Sheet! It Exists Dim wrkSheet As Worksheet SheetExists = False For Each wrkSheet In ThisWorkbook.Worksheets If wrkSheet.Name = sheetName Then SheetExists = True Exit For End If Next End Function Sub createMissingServicePages() ' start on first cell in ALL Sheets("all").Select Row1.Select Row1.Copy Dim serviceTypes serviceTypes = Array("Tree", "Graffiti", "Light", "Pothole") Dim serviceTypeName As String For Each serviceType In serviceTypes serviceTypeName = serviceType If Not SheetExists(serviceTypeName) Then ' create a new sheet - at the end of the Sheets list Sheets.Add After:=Sheets(Sheets.Count) ' after 8 ' and name it Sheets(Sheets.Count).Name = serviceTypeName ' by now its 9 ' select it and copy first row to it '.. copy header row Sheets("All").Select Rows(1).Select Rows(1).Copy ' .. paste in target sheet Sheets(Sheets.Count).Select Cells(1, 1).Select ActiveCell.PasteSpecial xlPasteAll End If Next End Sub Sub updateServicePages() ' if you wish to see the column numbers rather than letters ' change settings in Options / GENERAL tab to View R1C1 style Call createMissingServicePages ' start on first cell in ALL Sheets("all").Select Cells(1, 1).Select ' We'll need this later: ' count the columns Dim columnsCount As Integer For Each aCell In Rows(1).Cells If IsEmpty(aCell) Then columnsCount = aCell.Cells.Column Exit For End If Next ' get TypeOfService column number Dim serviceTypeHeaderText As String Dim serviceTypeColumnnum As Integer serviceTypeHeaderText = "type of service" ' ignoring case... Cells.Find(What:=serviceTypeHeaderText, _ After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate serviceTypeColumnnum = ActiveCell.Column ' sort the whole range Cells.Select ' first select the whole range ' unremark next line of code if you want to format the data nicely... 'Cells.EntireColumn.AutoFit ' if we are already at it Selection.Sort Key1:=Cells(1, serviceTypeColumnnum), _ Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal ' now move the data for each typeofService Dim serviceTypes Dim serviceTypeName As String serviceTypes = Array("Tree", "Graffiti", "Light", "Pothole") Dim rangeStart As Integer Dim rangeEnd As Integer For Each serviceType In serviceTypes ' we reset for each serviceType Sheets("all").Select Cells(1, 1).Select rangeStart = 0 rangeEnd = 0 serviceTypeName = serviceType ' .. find range start and end For Each aRow In Rows If aRow.Cells(serviceTypeColumnnum) = serviceTypeName Then If rangeStart = 0 Then rangeStart = aRow.Cells.Row Else If rangeStart <> 0 Then ' we just exited the range rangeEnd = aRow.Cells.Row - 1 Exit For ' done with this serviceType range Else ' didn't reach our range yet End If End If Next ' row ' No 'continue' in VBA... and don't want to use a GOTO ' If rangeStart = 0 Or rangeEnd = 0 Then 'continue for If rangeStart <> 0 And rangeEnd <> 0 Then ' .. now copy serviceType to correct sheet Dim servicetypeRange As Range Set servicetypeRange = Range(Cells(rangeStart, 1), Cells(rangeEnd, columnsCount)) servicetypeRange.Select servicetypeRange.Copy ' find empty row in target sheet Sheets(serviceTypeName).Select Dim emptyrowNum As Integer Dim emptyrowCount As Integer Dim emptyrowMax As Integer Dim emptyrowMargin emptyrowMax = 5 ' set this to 1 if there are no spaces in the data emptyrowMargin = 0 ' change this if you want an empty row between last data and new data For Each aRow In Rows If IsEmpty(aRow.Cells(1)) Then ' you could check over a few cells by: & isEmpty(aRow.Cells(2)) etc. emptyrowCount = emptyrowCount + 1 If emptyrowCount > emptyrowMax Then emptyrowNum = aRow.Row - emptyrowCount ' last empty row If emptyrowNum < 1 Then emptyrowNum = 1 emptyrowNum = emptyrowNum + emptyrowMargin Exit For ' we found empty row End If End If Next Cells(emptyrowNum, 1).Select ActiveCell.PasteSpecial xlPasteAll ' ,skipBlanks if needed End If Next ' serviceType Sheets("All").Select Cells(1, 1).Select MsgBox "Done!" End Sub