Snasui Excel Forum

Code: Select all

Public Sub EnvelopePaste()
    Dim rSource As Range
    Dim rTarget As Range
    Dim i As Long, j As Long
    Dim stCol As Byte
    Application.ScreenUpdating = False
    With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
        .Range("A:O").UnMerge
        '.Range("A:O").ClearContents
        If .Range("a1").Value = "" Then
            stCol = 1
            j = 1
        ElseIf .Range("b" & .Rows.Count).End(xlUp) = "" Then
            stCol = 1
            j = .Range("b" & .Rows.Count).End(xlUp).Row - 4
        Else
            stCol = 7
            j = .Range("i" & .Rows.Count).End(xlUp).Row - 4
        End If
    End With
    Set rSource = Sheets("Sheet1").Range("A1:G5")
    'j = 1
    For i = 1 To 10000 Step 2
        Sheets("Sheet1").Range("H1") = i
        If Sheets("KTB").Range("B" & i + 1) = "" Then Exit For
        With Sheets("·ÓÃٻẺ¾ÔÁ¾ì㺻Ð˹éÒ")
            Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
    '        End With
            If stCol = 1 Then
                rSource.Copy
                rTarget.PasteSpecial xlPasteValues
                rTarget.PasteSpecial xlPasteFormats
                Sheets("Sheet1").Range("H1") = i + 1
                rSource.Copy
                rTarget.Offset(0, 7).PasteSpecial xlPasteValues
                rTarget.Offset(0, 7).PasteSpecial xlPasteFormats
                j = j + 5
            Else
                rSource.Copy
                rTarget.Offset(0, 7).PasteSpecial xlPasteValues
                rTarget.Offset(0, 7).PasteSpecial xlPasteFormats
                j = j + 5
                Set rTarget = .Range(.Range("A" & j), .Range("G" & j + 4))
                Sheets("Sheet1").Range("H1") = i + 1
                rSource.Copy
                rTarget.PasteSpecial xlPasteValues
                rTarget.PasteSpecial xlPasteFormats
            End If
        End With
    Next i
    Application.CutCopyMode = False
    MsgBox "Finish"
    Application.ScreenUpdating = True
End Sub