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(xlCellTypeVisible).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 <perjesse...@hotmail.com> 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(xlCellTypeVisible).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, "Janet...@googlemail.com" <janet...@googlemail.com>
> 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
Similar Threads
