Macro : เลือก Department และ Package อยากให้โชว์ใน Sheet "Display" และ Sheet "Cal" อัตโนมัติ

[wisitsakbenz]

เรียนสอบถามอาจารย์ครับ

ตอนนี้ เลือก Department และ Package จะแสดงรายละเอียดใน Sheet "Display" อย่างเดียว
สิ่งที่ต้องการ
เมื่อเลือก Department และ Package อยากให้โชว์ใน Sheet "Display" และ Sheet "Cal" อัตโนมัติ
ไม่แน่ใจว่าต้องปรับ Code อย่างไรครับ อาจารย์
ขอบคุณครับ

Code: Select all

Sub GetData()

 Sheets("Display").Range("C10:D53").ClearContents

            Dim rFind As Range, rDataAll As Range
            Dim r As Range, rTarget As Range
            Dim ws As Worksheet, i As Integer
                Set ws = Worksheets("Display")
                Set rFind = Sheets("Display").Range("I7")
                Application.EnableEvents = False
                ws.Range("C10:D53").ClearContents
                
                If Sheets("Display").Range("I7") = "" Then Exit Sub
                
                With Sheets("Data")
                    Set rDataAll = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
                    If .Columns("D:D").Find(rFind, LookIn:=xlValues) Is Nothing Then
                        MsgBox ("ไม่มี Package นี้")
                        Exit Sub
                    End If
                End With
                i = 11
                For Each r In rDataAll
                    If r = rFind Then
                        ' ws.Range("c" & i).Font.Bold = True
                        ws.Range("c" & i).Resize(1, 2).Value = _
                            r.Offset(0, 3).Resize(1, 2).Value
                        i = i + 1
                    End If
                    
                Next r
                Application.EnableEvents = True
           ' MsgBox "Get data has finished."
            Set ws = Nothing
            Set rFind = Nothing
            Set rDataAll = Nothing
            
End Sub

[puriwutpokin]

ประมาณนี้หรือเปล่าครับ

Code: Select all

Sub GetData()

 'Sheets("Display").Range("C10:D53").ClearContents

            Dim rFind As Range, rDataAll As Range
            Dim r As Range, rTarget As Range
            Dim ws1, ws2 As Worksheet, i As Integer
                Set ws1 = Worksheets("Display")
                Set ws2 = Worksheets("Cal")
                Set rFind = Sheets("Display").Range("I7")
                Application.EnableEvents = False
                ws1.Range("C10:D53").ClearContents
                ws2.Range("C10:E53").ClearContents
                
                If Sheets("Display").Range("I7") = "" Then Exit Sub
                
                With Sheets("Data")
                    Set rDataAll = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
                    If .Columns("D:D").Find(rFind, LookIn:=xlValues) Is Nothing Then
                        MsgBox ("ไม่มี Package นี้")
                        Exit Sub
                    End If
                End With
                i = 11
                For Each r In rDataAll
                    If r = rFind Then
                        ' ws.Range("c" & i).Font.Bold = True
                        ws1.Range("c" & i).Resize(1, 2).Value = _
                            r.Offset(0, 3).Resize(1, 2).Value
                            ws2.Range("c" & i - 1).Value = _
                            r.Offset(0, 3).Value
                            ws2.Range("e" & i - 1).Value = _
                            r.Offset(0, 4).Value
                        i = i + 1
                    End If
                    
                Next r
                Application.EnableEvents = True
           ' MsgBox "Get data has finished."
            Set ws1 = Nothing
            Set ws2 = Nothing
            Set rFind = Nothing
            Set rDataAll = Nothing
            
End Sub

[wisitsakbenz]

ได้แล้วครับอาจารย์ puriwutpokin ขอบคุณมากครับ