ต้องการดึงข้อมูลล่าสุดของวัน ไปวางอีกไฟล์ โดยใช้ code vba

[March201711]

เช่น ต้องการ copy ข้อมูลสุดท้ายของเดือนที่ sheet "0324" คือ วันที่ 12/3/24 ไปวางไว้ที่ File : Copy_runLastdata ที่ sheet "0324" ต่อลงไปเรื่อยๆ แต่อยากให้ code มีความยึดหยุ่นน่ะค่ะ ต้องปรับเปลี่ยน code vba อย่างไรคะ

Code: Select all

Sub CopyData_to_otherFile()
'
' CopyData_to_otherFile Macro
'

'
    Range("B8").Select
    Selection.End(xlDown).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("J18").Select
    Windows("Copy_runLastdata.xlsx").Activate
    Sheets("0324").Select
    Range("B18").Select
    Selection.End(xlUp).Select
    Range("B3").Select
    Selection.End(xlDown).Select
    Range("B21").Select
    ActiveSheet.Paste
    Range("G17").Select
    Windows("Test_2024.xlsm").Activate
    Range("J15").Select
End Sub

[snasui]

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

Code: Select all

'Other code
Dim srb As Workbook, tgb As Workbook, srcRngs As Range

Set srb = ThisWorkbook
Set tgb = Workbooks("Copy_runLastdata.xlsx")

With srb.Worksheets("0324")
    Set srcRngs = .Range("b" & .Rows.Count).End(xlUp).Resize(, 4)
End With
With tgb.Worksheets("0324")
    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4).Value = srcRngs.Value
End With
'Other code

[March201711]

ค่ะ ได้แล้วค่ะ แต่ติดปัญหานิดนึงค่ะ ตรงนี้

Code: Select all

 With srb.Worksheets("0324")
 
With tgb.Worksheets("0324")  

ถ้าเดือนถัดไป เป็นเดือน 04 ที่ sheet 0424 ต้องมาเปลี่ยนที่ code vba เอง อยากให้ code รู้ได้เองว่าเป็นเดือนที่ทำ เป็นเดือน 04 เดือนปัจจุบันค่ะ

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

'Other code
'Other code
Dim srb As Workbook, tgb As Workbook, srcRngs As Range, myy As String

Set srb = ThisWorkbook
Set tgb = Workbooks("Copy_runLastdata.xlsx")
myy = Format(Date, "mmyy")
With srb.Worksheets(myy)
    Set srcRngs = .Range("b" & .Rows.Count).End(xlUp).Resize(, 4)
End With
With tgb.Worksheets(myy)
    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4).Value = srcRngs.Value
End With
'Other code

[March201711]

ได้เพิ่มบรรทัด total ที่ Row25 พอกดรันข้อมูลแล้ว วันที่ 12-03-2024 ไม่มาคะ มีแต่ Total มาแทน ค่ะ ต้องปรับ code vba อย่างไรคะ

[puriwutpokin]

ปรับตามนี้

Code: Select all

Sub CopyData_to_otherFile()
Dim srb As Workbook, tgb As Workbook, srcRngs As Range, x As Long
Set srb = ThisWorkbook
Set tgb = Workbooks("Copy_runLastdata.xlsx")
myy = Format(Date, "mmyy")
With srb.Worksheets(myy)
x = Application.Match(9E+99, .Range("b1:b999"))
    Set srcRngs = .Range("b" & x).Resize(, 4)
End With
With tgb.Worksheets(myy)
    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4).Value = srcRngs.Value
End With
End Sub

[March201711]

รบกวนสอบถามอีกนิดนึงค่ะ พอดึไฟล์ที่ใช้งานจริง จะมี ไฟล์นึงที่ใช้รัน marco ต่างหากโดยเฉพาะ เพราะไฟล์อื่นๆ ที่ได้จะเอามาจากแหล่งอื่น จึงไม่สามารถ สร้างปุ่มที่รัน marco ได้เฉพาะ ถ้าไฟล์เพิ่มอีกไฟล์นึงเป็นไฟล์งานที่ใช้สำหรับการรัน marco คือ file : Main_RunData.xlsx ซึ่ง ทั้งหมดมี 3 file ของการทำงาน คือ File ที่ 1.Main_RunData, File ที่ 2.Test_2024_adition toal, File ที่ 3.Copy_runLastdata พอกดปุ่มรัน แล้ว มันติด Debug ค่ะ ต้องปรับ code vba อย่างไรคะ ขอบคุณค่ะ

[puriwutpokin]

ปรับตามนี้ครับ

Code: Select all

Sub CopyData_to_otherFile()
Dim srb As Workbook, tgb As Workbook, srcRngs As Range, x As Long
Set srb = Workbooks("Test_2024_addition total.xlsx")
Set tgb = Workbooks("Copy_runLastdata.xlsx")
myy = Format(Date, "mmyy")
With srb.Worksheets(myy)
x = Application.Match(9E+99, .Range("b1:b999"))
    Set srcRngs = .Range("b" & x).Resize(, 4)
End With
With tgb.Worksheets(myy)
    .Range("b" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(, 4).Value = srcRngs.Value
End With
End Sub