ขอแก้ไขปรับ Code VBA ในการเพิ่มข้อมูล

[predee16]

ผมมีข้อมูลอยู่ 3 Sheet -> Sheet1,Sheet2,Sheet3 และต้องการข้อมูลบางส่วนมาเพิ่มใน ->TargetSheet
เงื่อนไขคือ คอลัมภ์ i <> ""
ผมต้องการแก้ไข Code คือ ย้ายนำข้อมูลมาตามเงื่อนไขมาเพิ่มที่ TargetSheet ต่อลงมาเรื่อยๆ
และลบข้อมูลออกจาก Sheet เดิม ตามตัวอย่างครับ

Code: Select all

Sub test()

Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim targetRow As Long
    Dim col As String

    ' Set the source worksheet
    Set wsSource = ActiveSheet

    ' Create a new worksheet for the target
    Set wsTarget = Worksheets.Add
    wsTarget.Name = "TargetSheet"

    ' Specify the column to check (e.g., "A" for column A)
    col = "i"

    ' Initialize the target row
    targetRow = 1

    ' Loop through each row from the bottom up
    lastRow = wsSource.Cells(wsSource.Rows.Count, col).End(xlUp).Row
    For i = lastRow To 1 Step -1
        Set cell = wsSource.Cells(i, col)

        ' Check if the cell in the specified column is not empty
        If cell.Value <> "" Then
            ' Copy the row to the target sheet
            wsSource.Rows(i).Copy Destination:=wsTarget.Rows(targetRow)
            ' Delete the row from the source sheet
            wsSource.Rows(i).EntireRow.Delete
            ' Move to the next row in the target sheet
            targetRow = targetRow + 1
        End If
    Next i
End Sub

[logic]

เปิดไฟล์ดูแล้วไม่เห็นมีโค้ด ลืมแนบหรือเปล่าครับ

[predee16]

Sub test() ครับ

[snasui]

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

Code: Select all

Sub test()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim targetRow As Long
    Dim col As String
    
    ' Create a new worksheet for the target
    Set wsTarget = Worksheets.Add
    wsTarget.Name = "TargetSheet"

    ' Specify the column to check (e.g., "A" for column A)
    col = "i"

    ' Initialize the target row
    targetRow = 1

    For Each wsSource In Worksheets
        If wsSource.Name <> "TargetSheet" Then
            ' Set the source worksheet
        '    Set wsSource = ActiveSheet
        
            ' Loop through each row from the bottom up
            lastRow = wsSource.Cells(wsSource.Rows.Count, col).End(xlUp).Row
            For i = lastRow To 1 Step -1
                Set cell = wsSource.Cells(i, col)
        
                ' Check if the cell in the specified column is not empty
                If cell.Value <> "" Then
                    ' Copy the row to the target sheet
                    wsSource.Rows(i).Copy Destination:=wsTarget.Rows(targetRow)
                    ' Delete the row from the source sheet
                    wsSource.Rows(i).EntireRow.Delete
                    ' Move to the next row in the target sheet
                    targetRow = targetRow + 1
                End If
            Next i
        End If
    Next wsSource
End Sub