ใช้มาโคร copy ข้อความจากชีทหนึ่งมาวางที่อีกชีทให้ข้อมูลต่อกัน

[momuskung]

สวัสดีทุกท่านค่ะ

รายละเอียด
1.ชีท center เป็นช่องให้กรอกข้อมูลมีจำนวน 6 บรรทัด ในการกรอกข้อมูลแต่ละครั้งอาจจะกรอกไม่ครบทั้ง 6 บรรทัด
2.ชีท DATA จะเป็นการเก็บข้อมูลจากชีท center มาเรียงตามต้องการก่อน
3.เมื่อกดปุ่ม save report ที่ชีท center จะ copy ข้อมูลจากชีท DATA ไปที่ชีท report โดยเก็บข้อมูลวางต่อจาก Row สุดท้ายที่มีข้อมูลต่อไปเรื่อยๆ

ปัญหาที่เจอ
ติดปัญหาใช้มาโคร copy ข้อความจากชีท DATA มาวางที่ชีท report แล้วข้อมูลไม่ต่อกัน ทุกครั้งจะ copy มา 6 ช่องพร้อมช่องว่าง
พอกด save report ใหม่ จะเว้นช่องว่างก่อนหน้าไว้ ไม่วางต่อจากช่องที่มีข้อมูลค่ะ ตอนนี้ต้องใช้วิธีฟิลเตอร์ให้ข้อมูลเรียงต่อกันแทนค่ะ

ที่ Module 5

Code: Select all

Sub Save_reportINV()

'Find the last used row in both sheets and copy and paste data below existing data.
    Dim lCopyLastRow2 As Long
    Dim lDestLastRow2 As Long


'Set variables for copy and destination sheets
  Set wsSheet2 = Workbooks("copy วางต่อ row สุดท้าย.xlsm").Worksheets("report")
  Set wsSheet5 = Workbooks("copy วางต่อ row สุดท้าย.xlsm").Worksheets("DATA")
  Set wsSheet6 = Workbooks("copy วางต่อ row สุดท้าย.xlsm").Worksheets("center")


'Set1
  lCopyLastRow2 = wsSheet5.Cells(wsSheet5.Rows.Count, "A").End(xlUp).Row
  lDestLastRow2 = wsSheet2.Cells(wsSheet2.Rows.Count, "A").End(xlUp).Offset(1).Row
  wsSheet5.Range("A2:B" & lCopyLastRow2).Copy
  wsSheet2.Range("A" & lDestLastRow2).PasteSpecial Paste:=xlPasteValues
  
  
'Disable marching ants around copied range
    wsSheet5.Application.CutCopyMode = False


wsSheet6.Range("B4").Select
End Sub

ขอบคุณล่วงหน้าค่ะ

[Bo_ry]

Code: Select all

Sub SaveR()
Dim r As Range
Set r = Sheets("center").Range("B4", Sheets("center").Cells(Rows.Count, 2).End(xlUp))
    With Sheets("report").Cells(Rows.Count, 2).End(xlUp)(2).Resize(r.Count)
        .Value = r.Value
        .Offset(, -1).Formula = "=counta(B$2:B" & .Row & ")"
        .Offset(, -1).Value = .Offset(, -1).Value
    End With
End Sub

[puriwutpokin]

จากโค้ดเดิมก็ใช้ได้นะครับ แต่ว่า เดิมที่ค่าว่างๆ จะมีค่าที่มองไม่เห็นอยู่ว่างอยู่จากข้อมูลมีสูตรที่มองไม่เห็น "" ที่ ชีท DATA ทำให้เวลาวางมันเห็น "" เป็นค่าด้วยครับ

[momuskung]

ได้ตรงตามต้องการแล้วค่ะ ขอบคุณมากนะคะ

Code: Select all

Sub SaveR()
Dim r As Range
Set r = Sheets("center").Range("B4", Sheets("center").Cells(Rows.Count, 2).End(xlUp))
    With Sheets("report").Cells(Rows.Count, 2).End(xlUp)(2).Resize(r.Count)
        .Value = r.Value
        .Offset(, -1).Formula = "=counta(B$2:B" & .Row & ")"
        .Offset(, -1).Value = .Offset(, -1).Value
    End With
End Sub