Snasui Excel Forum

Posted: **Mon Sep 27, 2021 10:19 am**

ตอนนี้แยก 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

Posted: **Mon Sep 27, 2021 10:58 am**

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

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
'...

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

Posted: **Mon Sep 27, 2021 11:09 am**

ผมลอง 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

Posted: **Mon Sep 27, 2021 11:12 am**

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

Posted: **Mon Sep 27, 2021 11:18 am**

แนบไฟล์ครับ

Posted: **Mon Sep 27, 2021 11:27 am**

teewa2032 wrote: Mon Sep 27, 2021 10:19 am อยากให้ sheet 1 ไปด้วยทุกไฟล์ครับ เช่น workbookA(sheet1,2) workbookA(sheet1,3) ค่า 2,3+ ไปจนหมดครับ

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

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

Posted: **Mon Sep 27, 2021 12:24 pm**

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

Posted: **Mon Sep 27, 2021 1:14 pm**

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

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
'...

Posted: **Mon Sep 27, 2021 1:35 pm**

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

Posted: **Mon Sep 27, 2021 1:37 pm**

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

Posted: **Mon Sep 27, 2021 1:44 pm**

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

Posted: **Mon Sep 27, 2021 2:17 pm**

teewa2032 wrote: Mon Sep 27, 2021 1:44 pm เวลา ผม 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 ในไฟล์ไหน ๆ มันมีชีตที่ชื่อซ้ำกันไม่ได้นะครับ

Posted: **Mon Sep 27, 2021 2:31 pm**

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

Snasui Excel Forum

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

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

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

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

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

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

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

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

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

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

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

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

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

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