我需要帮助Excel 2010中的VBA编写宏。
我需要知道如何根据一列中的条件复制特定范围的行，并将包含该指定条件的每一行（整行，所有其他字段）粘贴到相应的表中（下面将详细说明）。困难的部分是那些“目的地”表可能已经有一些需要在那里停留但不被删除的数据。那么，我怎么能写一个宏来做我刚刚描述的内容，但是当它去粘贴时，它会找到第一个开始粘贴的空行？
我有一张大约5张的工作簿。第一张工作表是包含所有数据的ALL工作表。接下来的4张名为Tree，Graffiti，Light和Pothole。所有5张纸上的所有字段都相同。在每个工作表中，都有一个名为Type Of Service的字段，它是这四种服务之一（tree，graffiti，light或pothole）。
我需要做的是为这4个服务中的每个服务（一次一个）过滤ALL表，选择所有字段和包含指定服务的所有行，将其全部复制并然后将其粘贴到单张纸上。那些单独的工作表可能包含一些数据，因此粘贴需要找到第一个空行，并将其粘贴到那里。将工作表与ALL工作表中复制的行连接。我需要宏来一起完成所有4个服务过滤器/粘贴。
答案 0 :(得分：1)
通过录制宏并查看它，您可以了解所有内容。 有一个额外的知识平静，而不是说“A1：G3” 你可以使用Range（Cells（x，y），Cells（x，y）） 并做例如
Range( Cells(1,1), Cells(1,3).Select
ActiveSelection.Copy ' or .Cut
转到Excel选项，然后在GENERAL选项卡上选择USE R1C1 Style。 excel也在列上显示数字。
找到空单元格
IsEmpty( Cells(3,9) )
用于打开现有工作表
Sheets("All").Select
所以
dim currentService
currentService = Cells(i, 3) ' current row, 13'th column
Sheets(currentService).Select
所以它是这样的： 找到过滤器函数，然后通过moveDown迭代单元格。
可能是最简单的 按服务排序 通过在线迭代直到找到其他内容来查找每个服务的开始和结束行 （那不是空的） 复制每项服务的整个范围 为该服务选择正确的书籍， 找到该服务单上的空行（通过读取每行上的单元格，或者如果要检查几个单元格：
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