ساخت شیت

[250xdsr]

با سلام و سپاس فراوان لطفا فایل رو ببینید

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[iranweld]

با سلام

فایل پیوست را ملاحظه بفرمایید

در صورت تایپ یک اسم در ستون f یک شیت به آن نام ساخته شده و محدوده جدول مورد نظر در آن کپی میگردد

Public xx As String

Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

z1 = Sheet1.Cells(Sheet1.Rows.Count, "f").End(xlUp).Row + 1

xx = Target.Address

If Not Intersect(Target, Me.Range("f6:f" & z1)) Is Nothing And Selection.Count = 1 And Target <> "" Then test
    
    
    End Sub
    
 Sub test()

Dim i As Integer, blnFound As Boolean
     
    With ThisWorkbook
     
     blnFound = False
        For i = 1 To .Sheets.Count
      
            If .Sheets(i).Name = Sheet1.Range(xx) Then
                blnFound = True
                MsgBox "sheet: " & .Sheets(i).Name & " exist"
               
            End If
        Next i
        
        If blnFound = False Then
            .Sheets.Add After:=Sheets(Sheets.Count)
            With ActiveSheet
                .Name = Sheet1.Range(xx)
                [form1].Copy Destination:=.Range("j6")
            End With
            
                End If
        
    End With
    
    Sheet1.Select
   
End Sub