Snasui Excel Forum

Code: Select all

Public Sub EnvelopePaste()
Dim rSource As Range
Dim rTarget As Range
Dim i As Long, j As Long
Application.ScreenUpdating = False
With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
    .Range("A:O").UnMerge
    .Range("A:O").ClearContents
End With
Set rSource = Sheets("Sheet1").Range("A1:G5")
j = 1
For i = 1 To 50000 Step 2
    Sheets("Sheet1").Range("H1") = i
    If Sheets("KTB").Range("D" & i) = "" Then Exit For
    With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
    Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
    End With
        rSource.Copy
        rTarget.PasteSpecial xlPasteValues
        rTarget.PasteSpecial xlPasteFormats
        j = j + 5
Next i
j = 1
For i = 2 To 50000 Step 2
    Sheets("Sheet1").Range("H1") = i
    If Sheets("KTB").Range("D" & i) = "" Then Exit For
     With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
        Set rTarget = .Range(.Range("I" & j), .Range("I" & j + 4))
    End With
        rSource.Copy
        rTarget.PasteSpecial xlPasteValues
        rTarget.PasteSpecial xlPasteFormats
        j = j + 5
Next i
Application.CutCopyMode = False
MsgBox "Finish"
Application.ScreenUpdating = True
End Sub