Copy each row to a different sheet

imad_Archi · Jan 27th 2020

Hey ,

I'm new to VBA and need some help.

Well I want to copy multiple ranges (row1, row2, row3....) that contains one picture each to a different sheet each time (sheet1, sheet2, sheet3...)

I recorded a macro that shows the operation for one row.

Code

Sub copy_product_info()
'
' copy_product_info Macro
Range("D2:I2").Select
Selection.Copy
Sheets("1").Select
Range("A6").Select
ActiveSheet.Paste
Sheets("MOBILIER UNIQUE PRODUCT").Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("1").Select
Range("A7:F25").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 3
Selection.ShapeRange.IncrementTop 8.25
Selection.ShapeRange.ScaleWidth 3, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 3, msoFalse, msoScaleFromTopLeft
End Sub

Display More

How can I do run this operation until the last row.

Thank you.

**AlanSidman** · Jan 28th 2020

Attach a sample workbook (not a picture or pasted copy). Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

imad_Archi · Jan 29th 2020

I could copy cells values and paste each row in a different sheet using this macro, but I still didn't find a solution to copy pictures.

Code

Sub Product_info_distribution()
Const FirstSht As String = "list" '<<< source sheet name
Dim vCol As Variant, vCell As Variant
vCol = Array("D", "E", "F", "G", "H", "I")
vCell = Array("A6", "B6", "C6", "D6", "E6", "F6")
Dim x As Long, y As Long
For x = 0 To UBound(vCol)
For y = 2 To 4
Sheets(y).Range(vCell(x)).Value = Sheets(FirstSht).Cells(y - 1, vCol(x)).Value
Next
Next
End Sub

Display More

You can find in attachements the eanted results.

thank you

Copy each row to a different sheet

Share

Tags