เรียงรายการด้วย vba

[Totem]

เรียนอาจารย์และเพื่อนสมาชิกทุกคน

การนำรายการแต่ละชีทให้มาเรียงต่อกันในชีทเดียว เมื่อ run sub ครั้งที่หนึ่ง รายการต่างๆในแต่ละชีทก็มาเรียงกันได้ปกติตั้งแต่ calls(1,1) แต่เมื่อ run sub ครั้งที่สอง ลบรายการทั้งหมดใน sheet2 อีกคร้้งแล้ว

Code: Select all

Worksheets("Sheet2").Rows(1 & ":" & Worksheets("Sheet2").Rows.Count).Delete

รายการต่างๆในแต่ละชีทไม่นำเรียงต่อกันตั้งแต่ calls(1,1) เหมือนครั้งแรก

Code: Select all

Cells(ActiveCell.SpecialCells(xlLastCell).Row, 1).Select
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

กลับไปวางรายการต่างๆเรียงต่อจากครั้งที่หนึ่งเหมือนมีรายการในคร้้งที่หนึ่งอยู่ (ซึ่งครั้งที่หนึ่งได้ถูกลบรายการเป็น sheet ว่างๆ ไปก่อนที่จะ run sub ครั้งที่สองแล้ว) ทำให้รายการที่เรียงต่อกันไม่ได้เริ่มที่ calls(1,1) ครับ
ช่วยปรับแก้ไขให้ด้วยครับ ขอบคุณครับ

เรียงรายการ.xlsm

(17.17 KiB) Downloaded 16 times

[snasui]

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

Code: Select all

Dim strName As String
Dim sheet As Worksheet
Dim wb As Workbook, nb As Workbook
Dim lstRow As Double

Set wb = ThisWorkbook

Application.DisplayAlerts = False

wb.Worksheets("Sheet2").UsedRange.Delete
file_path = "C:\sheetexcel\"
strName = dir(file_path & "\" & "*.xl??")

Do While strName <> vbaNullString
    If strName <> "" Then
        lstRow = wb.Worksheets("Sheet2").UsedRange.Rows.Count + 1
        Set nb = Workbooks.Open(fileName:=file_path & "\" & strName)
        nb.ActiveSheet.UsedRange.Copy
        wb.Worksheets("Sheet2").Range("a" & lstRow).PasteSpecial xlPasteValues
        nb.Close
    End If
    strName = dir
Loop

Application.CutCopyMode = False
Application.DisplayAlerts = True

wb.Sheets("Sheet1").Activate

[Totem]

ได้แล้วครับอาจารย์ ขอบคุณครับ