การคัลลอกตารางไปอีกเซลล์ ช่วยดูให้หน่อยครับ
คือมีเงือนไขอยู่ว่า
1 ถ้า x = y ให้คัดลอกไปอีกชีทหนึ่ง ถ้าไม่ใช้ ให้ y หาซ้ำจนกว่าจะเจอ
ถ้าเจอแล้วให้ตรวจบรรทัดทัดไปว่าเป็นเซลล์ว่างหรือไม่ ถ้าไม่ให้คัดลอก ถ้าว่างให้วน x ครับ
2 ให้ x  วนไปจนครบตามหรัสที่ต้องการหา

ตอนนี้ผมติดปัญหาคือไม่รู้จะเอาเงือนไข 2 อันนี้มารวมกันยังไง หรือผิดทั้งหมดก็ไม่แน่ใจ ผมรู้จักแต่ if loop แล้วก็ประกาศตัวแปร ถ้ามีคำสั่งไหนที่ช้วยแก้ไขได้ จะดีมากเลยครับ
ผมขอคำปรึกษาด้วยครับ


รายละเอียดในไฟล์น่ะครับ
ชีท TTH1 จะเป็นข้อมูลที่ใช้หา
ชีท TTH2 จะเป็นข้อมูลที่จะหา
ชีท TTH3 จะเป็นที่วางข้อมูล


ไฟล์ตัวอย่างครับ
https://drive.google.com/open?id=0Bw2wWVUku1UHWkxpa3ZxaG8zWUE
https://drive.google.com/open?id=0Bw2wWVUku1UHQTRfdU16bkk3VW8

code1
[Spoil] คลิกเพื่อดูข้อความที่ซ่อนไว้
Private Sub CommandButton2_Click()
Dim i As Integer
Dim j As Integer
Dim x As String
Dim y As String
Dim z As String
Dim p As String
Dim q As String
j = 2
i = 1
p = 1
q = 1

Do While j < 200
x = Sheets("TTH2").Cells(i, 1)
y = Sheets("TTH1").Cells(j, 2)
Select Case x
Case Is = y
Sheets("TTH1").Range(Cells(j, 1), Cells(j, 5)).Copy Sheets("TTH3").Cells(p, 1)
Do While p < 200
j = j + 1
p = p + 1
y = Sheets("TTH1").Cells(j, 2)
If y = "" Then
j = 200
Else
Sheets("TTH1").Range(Cells(j, 1), Cells(j, 5)).Copy Sheets("TTH3").Cells(p, 1)
q = q + 1
End If
Loop
Case Is <> y
j = j + 1
End Select
Loop
p = q + 1
End Sub



code2
[Spoil] คลิกเพื่อดูข้อความที่ซ่อนไว้
Private Sub CommandButton2_Click()
Dim i As Integer
Dim j As Integer
Dim x As String
Dim y As String
Dim p As String
Dim q As String
j = 2
i = 1

Do While i < 20
Do While j < 200
x = Sheets("TTH2").Cells(i, 1)
y = Sheets("TTH1").Cells(j, 2)

Select Case x
Case Is = y
Sheets("TTH1").Range(Cells(j, 1), Cells(j, 17)).Copy Sheets("TTH2").Cells(i, 2)
j = 200
Case Is <> y
Sheets("TTH2").Cells(i, 2) = "äÁ辺¢éÍÁÙÅ"
j = j + 1
End Select
Loop
i = i + 1
j = 2
Loop

End Sub