บันทึกข้อมูลข้าม Sheet ด้วย VBA

[babyminds]

อยากบันทึกข้อมูลด้วย VBA จากตัวอย่างคือ Sheet FX Copy J1:J86 ไปางที่ Sheet Act Year 23 ช่อง B4 แบบ Value และ Copy K1:K80 ที่ Sheet FX ไปวางที่ Sheet Ticket ช่อง B4 แบบ Value อยากได้ Vba ที่สามารถรันแล้ว นำข้อมูลไปวางทั้ง2ชีท โดยรันครั้งต่อไปก้อไห้เรียงไปตามวันที่ เช่น วันที่ 1/1/23 พอกดรันก้อไห้เอาข้อมูลไปวางตรังกับวันที่ ในชีท Act Year 23 และ ชีท Ticket

ไฟล์ตัวอย่างครับ
https://drive.google.com/file/d/1K7SDQw ... sp=sharing

[snasui]

กรุณาแนบไฟล์มาที่ฟอรัมนี้โดยตรง อ่านกฎการใช้บอร์ดทุกข้อด้านบนประกอบครับ

[babyminds]

File มันแนบไม่ได้ครับ เกินขนาด

[snasui]

ตัดมาเฉพาะที่เป็นปัญหาสร้างเป็นไฟล์ใหม่มีเพียงข้อมูลตัวอย่างที่สามารถแทนข้อมูลจริงได้ครับ

ปกติไม่ควรแนบไฟล์จริงมาทุกกรณียกเว้นสามารถเปิดเผยได้ครับ

[babyminds]

ตัวอย่าง.xlsb

นี่ครับ

[snasui]

ยังไม่มี Code ในไฟล์นั้น กรุณาเขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อ อ่านกฎการใช้บอร์ดข้อ 5 ด้านบนประกอบและต้องทำมาตามน้้นทุกครั้งไปครับ

[babyminds]

ตัวอย่าง.xlsb

นี่ครับ อยากให้มันบันทึกตามวันที่ไปเรื่อยๆครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("J1:J86").Select
    Selection.Copy
    Sheets("ACT YEAR 23").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("FX").Select
    Range("K1:K80").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ticket").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("FX").Select
    Range("G5").Select
    Application.CutCopyMode = False
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
'    Range("J1:J86").Select
'    Selection.Copy
'    Sheets("ACT YEAR 23").Select
'    Range("B4").Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Sheets("FX").Select
'    Range("K1:K80").Select
'    Application.CutCopyMode = False
'    Selection.Copy
'    Sheets("Ticket").Select
'    Range("B4").Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Sheets("FX").Select
'    Range("G5").Select
'    Application.CutCopyMode = False
    Dim c As Integer
    Dim s As Range
    With Worksheets("FX")
        Set s = .Range("j1", .Range("j" & .Rows.Count).End(xlUp))
    End With
    With Worksheets("ACT Year 23")
        If Application.CountIfs(.Range("3:3"), Worksheets("FX").Range("a3")) Then
            c = Application.Match(Worksheets("FX").Range("a3"), .Range("3:3"), 0)
            .Cells(4, c).Resize(s.Rows.Count, 1).Value = s.Value
            Worksheets("Ticket").Cells(4, c).Resize(s.Rows.Count, 1).Value = s.Offset(0, 1).Value
        Else
            MsgBox "Not found date.", vbExclamation
            Exit Sub
        End If
    End With
End Sub

[babyminds]

จากตัวอย่าง จะบันทึก ยอดขายจาก Colum J ไปวางที่ชีท 1 Colum K ไปวางที่ชีท 2
ตามวันที่ ช่อง A1 ต้องการเพิ่มให้ Colum L ไปวางที่ชีท 3 ต้องปรับแก้สูตรยังไงครับ

Capture.JPG

Code: Select all

Sub Macro2()
'
' Macro2 Macro
'

'
'    Range("J1:J9").Select
'    Selection.Copy
'    Sheets("1").Select
'    Range("B4").Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Sheets("FX").Select
'    Range("K1:K9").Select
'    Application.CutCopyMode = False
'    Selection.Copy
'    Sheets("2").Select
'    Range("B4").Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Sheets("FX").Select
'    Range("G5").Select
'    Application.CutCopyMode = False
    Dim c As Integer
    Dim s As Range
    With Worksheets("FX")
        Set s = .Range("j1", .Range("j" & .Rows.Count).End(xlUp))
    End With
    With Worksheets("1")
        If Application.CountIfs(.Range("3:3"), Worksheets("FX").Range("a1")) Then
            c = Application.Match(Worksheets("FX").Range("a1"), .Range("3:3"), 0)
            .Cells(4, c).Resize(s.Rows.Count, 1).Value = s.Value
            Worksheets("2").Cells(4, c).Resize(s.Rows.Count, 1).Value = s.Offset(0, 1).Value
        Else
            MsgBox "Not found date.", vbExclamation
            Exit Sub
        End If
    End With
End Sub

ตัวอย่าง1.xlsb

[babyminds]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
'    Range("J1:J86").Select
'    Selection.Copy
'    Sheets("ACT YEAR 23").Select
'    Range("B4").Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Sheets("FX").Select
'    Range("K1:K80").Select
'    Application.CutCopyMode = False
'    Selection.Copy
'    Sheets("Ticket").Select
'    Range("B4").Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Sheets("FX").Select
'    Range("G5").Select
'    Application.CutCopyMode = False
    Dim c As Integer
    Dim s As Range
    With Worksheets("FX")
        Set s = .Range("j1", .Range("j" & .Rows.Count).End(xlUp))
    End With
    With Worksheets("ACT Year 23")
        If Application.CountIfs(.Range("3:3"), Worksheets("FX").Range("a3")) Then
            c = Application.Match(Worksheets("FX").Range("a3"), .Range("3:3"), 0)
            .Cells(4, c).Resize(s.Rows.Count, 1).Value = s.Value
            Worksheets("Ticket").Cells(4, c).Resize(s.Rows.Count, 1).Value = s.Offset(0, 1).Value
        Else
            MsgBox "Not found date.", vbExclamation
            Exit Sub
        End If
    End With
End Sub

สอบถามครับ ถ้าต้องการเพิ่มอีกชีทนึง โดยเข้าข้อมูลจากชีท FX P1:P50 ไปวางที่ชีท P50 ช่อง B4 ต้องปรับแก้ตรงไหนครับ

[snasui]

ลองปรับมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบน ปรับได้เท่าไรก็เท่านั้น ติดตรงไหนค่อยถามกันต่อครับ