Snasui Excel Forum

เรียนท่านอาจารย์
ผมมีปัญหาเรื่องการนำ sheet 2 +sheet 3 รวมเป็นsheet 4ครับ
ตาม link http://www.snasui.com/viewtopic.php?f=3&t=1704 ที่อาจารย์แนะนำ ผมสามารถทำถูกต้องครบถ้วนครับ
แต่ติดอยู่ที่ว่า ผมมี sheet 1ถึง sheet 3 แล้วต้องการแค่ sheet 2 +sheet 3 รวมเป็นsheet 4ครับ
คือไม่ต้องการเอาsheet 1 ไปรวมครับ รบกวนท่านอาจารย์แนะนำด้วยครับ
และมีวิธีตรวจสอบก่อนหรือเปล่าครับว่า sheet 2และ sheet3 มีการกด saveก่อนหรือเปล่า
คือใช้code ของที่ท่านอาจารย์แนะนำครับ
กราบขอบพระคุณท่านจารย์ครับ
Sub CollectData()
Dim ws As Worksheet
Dim r As Range
Dim rTarget As Range
For Each ws In Worksheets
If ws.Name = "Sheet4" Then Exit Sub
With Sheets("Sheet4")
Set rTarget = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End With
Set r = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))
r.SpecialCells(xlCellTypeConstants).EntireRow.Copy
rTarget.PasteSpecial xlPasteValues
Next ws
Application.CutCopyMode = False
End Sub

Sub SortData()
Dim r As Range
Dim rs As Range
With Sheets("Sheet4")
Set r = .Range("A1", .Range("H" & Rows.Count).End(xlUp))
Set rs = r.Cells(2, 1).Offset(0, 3).Resize(r.Count - 1, 1)
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rs _
, SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With .Sort
.SetRange r
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub

Sub InsertRow()
Dim r As Range, rAll As Range
Dim i As Byte, rInsert As Range
Dim lng As Long
With Sheets("Sheet4")
Set rAll = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
For Each r In rAll
If r <> r.Offset(1, 0) Then
r.Offset(1, 5) = True
End If
Next r
Set rInsert = .Range("I:I").SpecialCells(xlCellTypeConstants)
For Each r In rInsert
r.Resize(2, 1).EntireRow.Insert shift:=xlShiftDown
r.Offset(-2, -7) = "Total"
r.Offset(-2, -4).Formula = "=sum(" & r.Offset(-3, -4).Address & ":" & _
r.Offset(-3, -4).End(xlUp).Address & ")"
r.Offset(-2, -3).Formula = "=sum(" & r.Offset(-3, -3).Address & ":" & _
r.Offset(-3, -3).End(xlUp).Address & ")"
r.Offset(-2, -2).Formula = "=sum(" & r.Offset(-3, -2).Address & ":" & _
r.Offset(-3, -2).End(xlUp).Address & ")"
r.Offset(-2, -1).Formula = "=sum(" & r.Offset(-3, -1).Address & ":" & _
r.Offset(-3, -1).End(xlUp).Address & ")"
Next r
rInsert.ClearContents
End With
End Sub

ควรปรับ Code ให้ตรงกับงานตัวเองก่อนครับ เมื่อปรับเองแล้วและยังติดปัญหาก็แจ้งให้ทราบจะได้ช่วยกันดูได้ หากไม่ได้ปรับมาเลยผมคงช่วยไม่ได้มาก หรือหากไม่แม่น Code ก็ใช้วิธีการบันทึก Macro แล้วปรับปรุงจาก Code ที่ได้นั้น ติดตรงไหนก็ถามมาได้เรื่อย ๆ ครับ

อีกประการควรแนบไฟล์ตัวอย่างที่มี Code ที่ได้ลองปรับมาเองแล้วจะได้ง่ายต่อการตรวจสอบมากกว่าการส่งมาเฉพาะ Code