Snasui Excel Forum

:thup: ขอบคุณอาจารย์มากค่ะ ช่วยให้การทำงานเร็วและง่ายขึ้นมากค่ะ

'Other code
wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
            .Offset(0, 4).PasteSpecial xlPasteValues
'Other code

:D ปรับ Code เป็นตามด้านล่างครับ

[code]
'Other code
wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
.Offset(0, 4).PasteSpecial xlPasteValues
'Other code[/code]

ค่ะอาจารย์

ไฟล์ ArBkShare.xlsx ชีท Sheet1 Code วางข้อมูลที่เซลล์ E23:S23 ที่ระบายสีแดงไว้ยังปรับไม่ได้ค่ะ ความต้องการปรับ Code ให้ข้อมูลวางที่เซลล์ E26:S26 ค่ะ

:D แนบมาเฉพาะที่เป็นปัญหาก็พอไม่จำเป็นต้องแนบมาทั้งหมด Code ที่[color=#FF4000]ไม่[/color]มีปัญหาไม่จำเป็นต้องแนบ ไม่ต้องแจ้งมาในกระทู้ครับ

ที่บอกว่าติดนั้น ติดตรงไหน อย่างไร มี Error อะไรขึ้นหรือไม่ แจ้งมาด้วยครับ

With formBook.Sheets("Template")
        .Range("A2:P2").Resize(.Range("Q1")).Copy
         wbShare.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp) _
            .Offset(1, 0).PasteSpecial xlPasteValues
    End With

Sub S_BillingDetails()
       'นำข้อมูลไปวางที่ไฟล์ ArBkShare.xlsx ชีท Sheet1 คอลัมน์ A2:D
        Dim formBook As Workbook
        Dim dtShare As Workbook
        Dim mr As Range
        Dim i As Double
        Set formBook = ThisWorkbook
        Set dtShare = Workbooks("ArBkShare.xlsx")
        Set mr = dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        On Error Resume Next
        dtShare.Sheets("Sheet1").ShowAllData
            With formBook.Sheets("Form")
                i = (.Range("P9") + .Range("M12"))
                If i <> .Range("J12") Then
                    Exit Sub
                End If
             End With
   
              With formBook.Sheets("Template")
                      .Range("A20:D20").Resize(.Range("E19")).Copy
                      dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
                      .Offset(1, 0).PasteSpecial xlPasteValues
               End With
        dtShare.Save
  End Sub

Sub ArBilling()
    Dim formBook As Workbook
    Dim wbShare As Workbook
    Dim wb As Workbook ' declare wb as workbook
    Dim wdShare As Workbook
    Dim wdShareOpen As Boolean
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Dim lastRow As Long
    Dim shRange As Range
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBkShare.xlsx")
    On Error Resume Next
    wbShare.Sheets("Sheet1").ShowAllData
    For Each wb In Workbooks ' loop wb not loop wdShare
        If wb.Name = "WbShare.xlsx" Then
            wdShareOpen = True
        End If
    Next wb
    If Not wdShareOpen Then
   
    End If
   Set wdShare = Workbooks("WbShare.xlsx") 'set wdShare after open not before open
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("F2", .Range("F" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("P9") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
            Exit Sub
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 26) = "B"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
   
    With formBook.Sheets("Template")
        .Range("A2:P2").Resize(.Range("Q1")).Copy
         wbShare.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp) _
            .Offset(1, 0).PasteSpecial xlPasteValues
    End With
           
    formBook.Sheets("Form").Range("H1,J4:O8,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("j2") = .Range("j2") + 1
        .Range("i4") = .Range("i4") + 1
    End With
       
         wdShare.Save
         wbShare.Save
        formBook.Save
        formBook.Activate
        Range("H1").Select
End Sub

เรียนอาจารย์และท่านผู้รู้ค่ะ

ที่ไฟล์ Form บันทึกข้อมูลไปวางที่ไฟล์ ArBkShare.xlsx ชีท Sheet1 คอลัมน์ A:D และ E:S การวางข้อมูลแต่ละครั้งจำบรรทัดไม่เท่ากันคอลัมน์ A:D อาจจะมีหนึ่งหรือหลายๆบรรทัด แต่คอลัมน์ E:S การวางข้อมูลจะมีเพืยงหนึ่งบรรทัดเท่านั้นค่ะ

ต้วอย่างที่ต้องการไฟล์ ArBkShare.xlsx ชีท Sheet1 ระบายสีเหลืองไว้ค่ะ
ที่ระบายสีแดงยังเป็นปัญหาค่ะ ติดที่ Code นี้ค่ะ ได้แนบ Code ทั้งชุดมาดูว่าควรปรับอย่างไรค่ะ
[code]With formBook.Sheets("Template")
.Range("A2:P2").Resize(.Range("Q1")).Copy
wbShare.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
End With[/code]
Code นำข้อมูลไปวางที่ไฟล์ ArBkShare.xlsx ชีท Sheet1 คอลัมน์ A2:D ค่ะ
[code]Sub S_BillingDetails()
'นำข้อมูลไปวางที่ไฟล์ ArBkShare.xlsx ชีท Sheet1 คอลัมน์ A2:D
Dim formBook As Workbook
Dim dtShare As Workbook
Dim mr As Range
Dim i As Double
Set formBook = ThisWorkbook
Set dtShare = Workbooks("ArBkShare.xlsx")
Set mr = dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
On Error Resume Next
dtShare.Sheets("Sheet1").ShowAllData
With formBook.Sheets("Form")
i = (.Range("P9") + .Range("M12"))
If i <> .Range("J12") Then
Exit Sub
End If
End With

With formBook.Sheets("Template")
.Range("A20:D20").Resize(.Range("E19")).Copy
dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
End With
dtShare.Save
End Sub[/code]

Code นำข้อมูลไปวางที่ไฟล์ ArBkShare.xlsx ชีท Sheet1 คอลัมน์ E26:S26 ค่ะ

[code]Sub ArBilling()
Dim formBook As Workbook
Dim wbShare As Workbook
Dim wb As Workbook ' declare wb as workbook
Dim wdShare As Workbook
Dim wdShareOpen As Boolean
Dim rSource As Range
Dim rTarget As Range
Dim rs As Range
Dim rt As Range
Dim i As Double
Dim lastRow As Long
Dim shRange As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("ArBkShare.xlsx")
On Error Resume Next
wbShare.Sheets("Sheet1").ShowAllData
For Each wb In Workbooks ' loop wb not loop wdShare
If wb.Name = "WbShare.xlsx" Then
wdShareOpen = True
End If
Next wb
If Not wdShareOpen Then

End If
Set wdShare = Workbooks("WbShare.xlsx") 'set wdShare after open not before open
With formBook.Sheets("Form")
Set rSource = .Range("B3:B50")
End With
With wdShare.Sheets("Sheet1")
Set rTarget = .Range("F2", .Range("F" & Rows.Count).End(xlUp))
End With
With formBook.Sheets("Form")
i = (.Range("P9") + .Range("M12"))
If i <> .Range("J12") Then
MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
Exit Sub
End If
End With
Application.Calculation = xlCalculationManual
For Each rs In rSource
For Each rt In rTarget
If rt = rs Then rt.Offset(0, 26) = "B"
Next rt
Next rs
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

With formBook.Sheets("Template")
.Range("A2:P2").Resize(.Range("Q1")).Copy
wbShare.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
End With

formBook.Sheets("Form").Range("H1,J4:O8,M12").ClearContents
With formBook.Sheets("Form")
.Range("j2") = .Range("j2") + 1
.Range("i4") = .Range("i4") + 1
End With

wdShare.Save
wbShare.Save
formBook.Save
formBook.Activate
Range("H1").Select
End Sub[/code]