code copy sang file mới và đặt tên

[romado]

Chào các Anh, Chị, Em trên diễn đàn. Mình nhờ cả nhà giúp mình một đoạn Code mà có thể tự động copy sang file mới và đặt tên sheet theo tên tại một ô trong bảng tính. Ví dụ như file mình đính kém. mình muốn copy sang file mới và đặt tên sheet có dữ liệu theo ô M2. (tức là tên sheet sẽ là: "156CCTL10")

Cảm ơn cả nhà.

 

[nguyenthuy13388]

Chào các Anh, Chị, Em trên diễn đàn. Mình nhờ cả nhà giúp mình một đoạn Code mà có thể tự động copy sang file mới và đặt tên sheet theo tên tại một ô trong bảng tính. Ví dụ như file mình đính kém. mình muốn copy sang file mới và đặt tên sheet có dữ liệu theo ô M2. (tức là tên sheet sẽ là: "156CCTL10")

Cảm ơn cả nhà.

Bạn thử:

Sub taoFilemoi()
Dim WbMoi As Workbook
Dim Wbcu As Workbook
Dim FName As String

Set Wbcu = ThisWorkbook
ActiveSheet.Copy

Set WbMoi = ActiveWorkbook
With WbMoi
    If Right(Wbcu.Name, 3) = "xls" Then
        FName = Wbcu.Path & "\" & .ActiveSheet.Range("M2").Value & ".xls"
    Else
        FName = Wbcu.Path & "\" & .ActiveSheet.Range("M2").Value & Right(Wbcu.Name, 5)
    End If
    If Dir(FName) <> "" Then
        MsgBox "File Name bi trùng"
        WbMoi.Close savechanges:=False
    Else
        .SaveAs Filename:=FName, FileFormat:=Wbcu.FileFormat
        .Close savechanges:=True
    End If
End With
End Sub

 

[romado]

Bạn thử:

Sub taoFilemoi()
Dim WbMoi As Workbook
Dim Wbcu As Workbook
Dim FName As String

Set Wbcu = ThisWorkbook
ActiveSheet.Copy

Set WbMoi = ActiveWorkbook
With WbMoi
    If Right(Wbcu.Name, 3) = "xls" Then
        FName = Wbcu.Path & "\" & .ActiveSheet.Range("M2").Value & ".xls"
    Else
        FName = Wbcu.Path & "\" & .ActiveSheet.Range("M2").Value & Right(Wbcu.Name, 5)
    End If
    If Dir(FName) <> "" Then
        MsgBox "File Name bi trùng"
        WbMoi.Close savechanges:=False
    Else
        .SaveAs Filename:=FName, FileFormat:=Wbcu.FileFormat
        .Close savechanges:=True
    End If
End With
End Sub

Cảm ơn
nguyenthuy13388
mình đã thử đoạn code trên nó ok nhưng nó lại đặt tên file ở ô m2 là "156CCTL10", có cách nào mà nó đặt tên sheet ở ô m2 là 156CCTL10 ko Bác?

 

[nguyenthuy13388]

Cảm ơn
nguyenthuy13388
mình đã thử đoạn code trên nó ok nhưng nó lại đặt tên file ở ô m2 là "156CCTL10", có cách nào mà nó đặt tên sheet ở ô m2 là 156CCTL10 ko Bác?

Bạn dùng code dưới đây:

Sub taoFilemoi()
Dim WbMoi As Workbook
Dim Wbcu As Workbook
Dim FName As String

Set Wbcu = ThisWorkbook
ActiveSheet.Copy

Set WbMoi = ActiveWorkbook
With WbMoi
    If Right(Wbcu.Name, 3) = "xls" Then
        FName = Wbcu.Path & "\" & .ActiveSheet.Range("M2").Value & ".xls"
    Else
        FName = Wbcu.Path & "\" & .ActiveSheet.Range("M2").Value & Right(Wbcu.Name, 5)
    End If
    If Dir(FName) <> "" Then
        MsgBox "File Name bi trùng"
        WbMoi.Close savechanges:=False
    Else
        With wbmoi.activesheet
           if .range("M3").value=""then
             msgbox "Cell M3 khong co du lieu"
           else
             .name=.range("M3").value
           end if
        end with
        .SaveAs Filename:=FName, FileFormat:=Wbcu.FileFormat
        .Close savechanges:=True
    End If
End With
End Sub