snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Option Explicit
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 10000 Step 2
Sheets("Sheet1").Range("H1") = i
If Sheets("KTB").Range("B" & 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 10000 Step 2
Sheets("Sheet1").Range("H1") = i
If Sheets("KTB").Range("B" & 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
You do not have the required permissions to view the files attached to this post.