Copy range based on condition
 

Hi

Newbie here hoping some help. I have this code to copy a whole range to
another worsheet:
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Sheets("Sales-Inventory").Range("UPC",
Range("MK_ID").End(xlDown))
Set rng2 = Sheets("Sales-Inventory").Range("Figure",
Range("Figure").End(xlDown))
rng1.Copy
Sheets("BAUCS").Range("C11").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
rng2.Copy
Sheets("BAUCS").Range("C37").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = True

End Sub

The problem with this code is that copies the whole range and I need to
change this code to look into column A and copy the values based on the value
located in this column to the corresponding worsheet. In column A I have six
options like this: RE,AS, KJ, JC, XC, MN I need to copy cells B, C and P to
differents worsheets which are named the same as the six options I mentioned
before. Did I explain clearly? Let me know.

Can anybody help me with this, please.

Thanks

Copy range based on condition
 

Dim sh as Worksheet, cell as Range
Dim rng3 as Range, rng1 as Range
With Worksheets("Sales-Inventory")
set rng1 = .Range(.Cells(1,1),.Cells(rows.count,1).End(xlup))
End With

for each cell in rng
Set sh = Nothing
on Error Resume Next
set sh = Worksheets(cell)
On Error goto 0
if not sh is nothing then
set rng3 = sh.Cells(rows.count,1).End(xlup)(2)
sh.Cells(rng3.row,2) = cell.offset(0,1)
sh.Cells(rng3.row,3) = cell.offset(0,2)
sh.Cells(rng3.row,15) = cell.offset(0,15)
end if
Next

--
Regards,
Tom Ogilvy



"Sotomayor" wrote in message
...
Hi

Newbie here hoping some help. I have this code to copy a whole range to
another worsheet:
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Sheets("Sales-Inventory").Range("UPC",
Range("MK_ID").End(xlDown))
Set rng2 = Sheets("Sales-Inventory").Range("Figure",
Range("Figure").End(xlDown))
rng1.Copy
Sheets("BAUCS").Range("C11").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
rng2.Copy
Sheets("BAUCS").Range("C37").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Application.CutCopyMode = True

End Sub

The problem with this code is that copies the whole range and I need to
change this code to look into column A and copy the values based on the
value
located in this column to the corresponding worsheet. In column A I have
six
options like this: RE,AS, KJ, JC, XC, MN I need to copy cells B, C and P
to
differents worsheets which are named the same as the six options I
mentioned
before. Did I explain clearly? Let me know.

Can anybody help me with this, please.

Thanks