Hi Per,

thanks for your great help. See my changes in your code. On the
ubound it is not compiling -Expected Array. What is wrong?

Sub ConditionalCopy()

Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr As Range
Dim Ca As Double


Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For Ca = UBound(CritArr) To LBound(CritArr) Step -1
sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(Ca, 1)
Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
Set DestCell = DestCell.End(xlUp).Offset(1)
CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub



On Dec 12, 5:00*pm, Per Jessen wrote:
This should do it:

Sub ConditionalCopy()
Dim Source As Worksheet
Dim Dest As Worksheet
Dim sourceRng As Range
Dim CopyRng As Range
Dim DestCell As Range
Dim CritArr

Set Source = Worksheets("Sheet1")
Set Dest = Worksheets("Sheet2")
CritArr = Dest.Range("A2", Dest.Range("A2").End(xlDown)).Value
Set sourceRng = Source.Range("A1", Source.Range("D1").End(xlDown))
Set CopyRng = sourceRng.Offset(1).Resize(sourceRng.Rows.Count - 1, 4)
Set DestCell = Dest.Range("A1").End(xlDown).Offset(1)
For ca = UBound(CritArr) To LBound(CritArr) Step -1
* * sourceRng.AutoFilter Field:=4, Criteria1:=CritArr(ca, 1)
* * Debug.Print DestCell.Address

DestCell.Resize(CopyRng.SpecialCells(xlCellTypeVis ible).Rows.Count,
1).EntireRow.Insert
* * Set DestCell = DestCell.End(xlUp).Offset(1)
* * CopyRng.SpecialCells(xlCellTypeVisible).Copy DestCell
* * Set DestCell = DestCell.Offset(-1)
Next
sourceRng.AutoFilter
End Sub

Regarsd,
Per

On 12 Dec., 19:05, "
wrote:

Hi Everybody, I was hoping that anybody in this forum could help me
solve my particular vba problem in Excel. I need to add information
from one sheet to the other based on a certain criteria. This is how
my
information looks like:

Sheet "Source"
Code|Description|Explanation|RollupGroup
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...
Sheet "Target"
RollupGroup|Description|ISourcetems|Cost
10|Fabric|Fabric Selections|3|12.12
20|Stitching|Stitching Instruction|2|2.33
30|Yarn Selection|2|0.56
...

I need to copy the detail information (entire row) from the source
sheet to the target sheet based on the RollupGroup information.
My new target sheet should then look like this:

Sheet "Target" (After Change)
10|Fabric|Fabric Selections|3|12.12
AA|Color:Green|ColorCodeA45|10
AB|Fabric:Cotton|NoStretch|10
AD|Pattern:Nuendo|ReferenceAD12|10
20|Stitching|Stitching Instruction|2|2.33
BR|Quality:3ply|8907|20
BO|Stitch:4|DoubleCross|20
30|Yarn Selection|2|0.56
CA|Yarn:1.2"|6 Threat|30
CF|Length" 23m|Excess .2|30
...

Anyones help is greatly appreciated!

Regards, Weitwinkel