I'm trying to copy entire rows of the Sheet ‘All’ to another s开发者_运维问答heet according to the data in column D. There are multiple values in column D (Homework/Advanced/Beginner) and the sheets these rows need to be copied to have corresponding names. (Homework to Homework sheet.)
The data in Sheet ‘All’ will be added on to and the new data needs to be copied without duplicating the ones that are already there.
It's not a big problem. The best thing is to keep things simple and copy everything whenever "all" changes. I'd have a "Redistribute" button on the "all" sheet and have the event call scatterRows()
You don't say what your source sheet looks like so I made something up for sheet "all":
9 0.181626294 carrot beginner Irene
5 0.221180184 beans advanced Eva
8 0.221813735 turnip advanced Harry
10 0.314800867 lettuce homework John
4 0.360163255 peas homework Doug
11 0.379956592 pepper advanced Karen
3 0.44415906 tomato beginner Charlie
6 0.647446239 corn beginner Frank
2 0.655706735 potato advanced Bob
7 0.666002258 lentils homework George
1 0.768524361 squash homework Alice
The code is fairly flexible; it finds the whole source block, so it doesn't matter how many columns you have as long as column "D" holds the sheet key and the data starts in A1 (no headings). If you have headings, change all the A1 references to A2.
The other sheets ("homework" etc) must have been created. --And you need a reference set to the Microsoft Scripting Runtime.
The only "interesting" part of the code is figuring out the string for the target range (putString).
Option Explicit
'' Copy rows from the "all" sheet to other sheets
'' keying the sheetname from column D.
'' **** Needs Tools|References|Microsoft Scripting Runtime
'' Changes:
'' [1] fixed the putString calculation.
'' [2] Added logic to clear the target sheets.
Sub scatterRows()
Dim srcRange As Range
Dim srcRow As Range
Dim srcCols As Integer
Dim srcCat As String
Dim putRow As Integer
Dim putString As String
Dim s ''*New [2]
'' Current row for each category
Dim cats As Dictionary
Set cats = New Dictionary
cats.Add "homework", 0
cats.Add "beginner", 0
cats.Add "advanced", 0
'' Clear the category sheets *New [2]
For Each s In cats.Keys
Range(s & "!A1").CurrentRegion.Delete
Next s
'' Find the source range
Set srcRange = [all!a1].CurrentRegion
srcCols = srcRange.Columns.Count
'' Move rows from source Loop
For Each srcRow In srcRange.Rows
'' get the category
srcCat = srcRow.Cells(4).Value
'' get the target sheet row and increment it
putRow = cats(srcCat) + 1
cats(srcCat) = putRow
'' format the target range string *Fixed [1]
'' e.g. "homework!A3:E3"
putString = srcCat & "!" & _
[a1].Offset(putRow - 1, 0).Address & _
":" & [a1].Offset(putRow - 1, srcCols - 1).Address
'' copy from sheet all to target sheet
Range(putString).Value = srcRow.Value
Next srcRow
End Sub
精彩评论