Sub M_E()
With Application
.ScreenUpdating = False
.EnableEvents = False
lrs = Sheets("shoab").Cells(Rows.Count, 1).End(3).Row
lrn = Sheets("all").Cells(Rows.Count, 1).End(3).Row
Sheets("all").Range("a2:f" & lrn).ClearContents
rr = 2
For s1 = 2 To lrs
Do While Sheets("all").Cells(rr, 1) = ""
Sheets("all").Range("a" & rr & ":a" & rr + 81) = Sheets("shoab").Cells(s1, 2)
Sheets("all").Range("b" & rr & ":b" & rr + 81) = Sheets("shoab").Cells(s1, 3)
Sheets("all").Range("c" & rr & ":c" & rr + 81) = Sheets("shoab").Cells(s1, 4)
Sheets("All Products").Range("a2:c83").Copy
Sheets("all").Range("d" & rr & ":f" & rr + 81).PasteSpecial (xlPasteValues)
Loop
rr = rr + 82
Next s1
.CutCopyMode = False
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
کامنت