อยากแยก sheet ไปไฟล์ใหม่ แต่ให้เอา sheet 1 ไปด้วยตลอดทำยังไงได้บ้างครับใช่ VBA

[teewa2032]

ตอนนี้แยก sheet to file ได้แต่ อยากให้ sheet 1 ไปด้วยทุกไฟล์ครับ เช่น workbookA(sheet1,2) workbookA(sheet1,3) ค่า 2,3+ ไปจนหมดครับ

Code: Select all

Public Sub rr()
Dim i As Integer


    For i = 1 To Workbooks("SheetToWorkbook.xlsb").Worksheets.Count
    
    
        Workbooks("SheetToWorkbook.xlsb").Worksheets(i).copy
       
        strFileName = ActiveSheet.Name & ".xlsx"
        ActiveWorkbook.Sheets(1).Range("b1").Value = ActiveWorkbook.Sheets(1).Name
       
        ActiveWorkbook.SaveAs Filename:="C:\Temp\" & _
            ActiveSheet.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
       File = ActiveSheet.Name & ".xlsx"
       
        ActiveWorkbook.Close False
        
    Next i
End Sub

[logic]

น่าจะแนว ๆ นี้นะครับ

Code: Select all

'...
For i = 1 To Workbooks("SheetToWorkbook.xlsb").Worksheets.Count
    With Workbooks("SheetToWorkbook.xlsb")
        .Activate
        .Worksheets(Array(.Worksheets(i).Name, "Sheet1")).Copy
    End With
    strFileName = ActiveSheet.Name & ".xlsx"
    '...
Next i
'...

ตรง '... นี่คือโค้ดเดิมที่เขียนเอาไว้แล้ว

[teewa2032]

ผมลอง debug

Code: Select all

Dim i As Integer
For i = 1 To Workbooks("SheetToWorkbook.xlsb").Worksheets.Count
    With Workbooks("SheetToWorkbook.xlsb")
        .Activate
        .Worksheets(Array(.Worksheets(i).Name, "Sheet1")).copy
    End With
    strFileName = ActiveSheet.Name & ".xlsx"
     ActiveWorkbook.Sheets(1).Range("b1").Value = ActiveWorkbook.Sheets(1).Name
     ActiveWorkbook.SaveAs Filename:="C:\Temp\" & _
    ActiveSheet.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
       File = ActiveSheet.Name & ".xlsx"
       
        ActiveWorkbook.Close False
Next i

Error runtime 9
.Worksheets(Array(.Worksheets(i).Name, "Sheet1")).copy

[logic]

แนบไฟล์มาด้วยดีกว่าไหมครับ

[teewa2032]

แนบไฟล์ครับ

[logic]

อยากให้ sheet 1 ไปด้วยทุกไฟล์ครับ เช่น workbookA(sheet1,2) workbookA(sheet1,3) ค่า 2,3+ ไปจนหมดครับ

ไฟล์ที่แนบมาไม่มีชีตที่ชื่อ Sheet1 ครับ

.Worksheets(Array(.Worksheets(i).Name, "Sheet1")).Copy <~~ คือการก็อปปี้ Sheet1 ไปกับ Sheet ลำดับ i ไปพร้อม ๆ กัน ถ้าไม่มี Sheet1 ก็ฟ้องว่าผิดพลาดครับ

[teewa2032]

อ่อครับ
แต่ลองดู Save file ออกมาเป็น workbook ได้แค่อันเดียวครับ ทำยังไงให้ ได้ workbook เท่ากับ sheet ครับ

[logic]

โค้ดนี้เซฟได้อยู่นะครับ

Code: Select all

'...
For i = 1 To Workbooks("SheetToWorkbook.xlsb").Worksheets.Count
    With Workbooks("SheetToWorkbook.xlsb")
        .Activate
        .Worksheets(Array(.Worksheets(i).Name, "2123")).copy
    End With
    With ActiveWorkbook
        strFileName = ActiveSheet.Name & ".xlsx"
        .Sheets(1).Range("b1").Value = .Sheets(1).Name
        .SaveAs Filename:="C:\Temp\" & _
            strFileName, FileFormat:=xlOpenXMLWorkbook
        'File = ActiveSheet.Name & ".xlsx"
        .Close False
    End With
Next i
'...

[teewa2032]

ประมาณนี้ครับ
แบบ sheet1 ไป ยังทุกไฟล์ที่แยกออกมาครับ ให้อยู่ sheet แรกทุกไฟล์ ที่คุณ logic อีกนิดเดียว

[logic]

โค้ดนั้นทำไม่ได้อีกหรือครับ ติดตรงไหนครับ

[teewa2032]

เวลา ผม run sheet 2123 อยู่ทุกไฟล์ แต่ไม่อยู่ sheet แรกครับ

[logic]

เวลา ผม run sheet 2123 อยู่ทุกไฟล์ แต่ไม่อยู่ sheet แรกครับ

Code: Select all

'...
For i = 1 To Workbooks("SheetToWorkbook.xlsb").Worksheets.Count
    With Workbooks("SheetToWorkbook.xlsb")
        .Activate
         strFileName = .Worksheets(i).Name & ".xlsx"
        .Worksheets(Array(.Worksheets(i).Name, "sheet1")).copy
    End With
    With ActiveWorkbook
       ' strFileName = ActiveSheet.Name & ".xlsx"
        .Sheets(1).Range("b1").Value = .Sheets(1).Name
        .SaveAs Filename:="C:\Temp\" & _
            strFileName, FileFormat:=xlOpenXMLWorkbook
        .Close False
    End With
Next i
'...

อันนี้โค้ดเดิมแค่ย้ายบรรทัดให้มันแม่นขึ้น ไม่ได้เกี่ยวกับปัญหาที่บอกมาครับ

ต้องการเอา Sheet1 ไปคู่กับ Sheet อื่น ๆ ก็จะเป็นแบบนี้
1. Sheet1 ไปกับ Sheet1
2. 1111jjdjdjjjd ไปกับ Sheet1
3. reertetet ไปกับ Sheet1
4. 2123 ไปกับ Sheet1

อันนี้ต้องเข้าใจว่า Sheet1 มันจะไม่คู่กับ Sheet1 ในไฟล์ไหน ๆ มันมีชีตที่ชื่อซ้ำกันไม่ได้นะครับ

[teewa2032]

โอ้ว ขอบคุณ คุณ logic มากๆครับ