موزیک اس ام اس و جوک نرم افزار دل نوشته

' @mas76nrm 2023/11/26

Private Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet

If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function

'Function WorksheetExists(sName As String) As Boolean
' WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
'End Function

'Private Function getCity(cityPersianName As String)
' Dim cities As Variant
' cities = Array( _
' Array("مرکز استان", "Center"), _
' Array("اردب?ل", "Ardabil"), _
' Array("پارس آباد", "Parsabad"), _
' Array("بيله سوار", "BileSavar") _
' )
' Dim i As Integer
' getCity = "test"
' For i = 0 To 3
' If cities(i)(0) = cityPersianName Then
' getCity = cities(i)(1)
' Exit For
' End If
' Next i
'End Function

Private Function copyRow(sourceSheet As String, destinationSheet As String, rowNumber As Integer, Optional increaseRow As Boolean = False)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow As Long

Set ws1 = ThisWorkbook.Sheets(sourceSheet)
Set ws2 = ThisWorkbook.Sheets(destinationSheet)
lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
If increaseRow Then
lastRow = lastRow + 1
End If
ws1.Rows(rowNumber).EntireRow.copy ws2.Range("A" & lastRow)
copyRow = True
End Function

Public Sub extractCities()

Dim rowCounter As Integer
Dim city As String
Dim res As Boolean

ThisWorkbook.Sheets("Personels").Select

For rowCounter = 3 To 1000
city = Cells(rowCounter, 8).Value
If WorksheetExists(city) Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(city).Delete
Application.DisplayAlerts = True
End If
Next rowCounter

For rowCounter = 3 To 1000
ThisWorkbook.Sheets("Personels").Select
city = Cells(rowCounter, ThisWorkbook.Sheets("Personels").Cells(1, 5)).Value
If Not IsNull(city) And city <> "" Then
If Not WorksheetExists(city) Then
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = city
.Sheets(.Sheets.Count).DisplayRightToLeft = True
End With
res = copyRow("Personels", city, 2)
End If
res = copyRow("Personels", city, rowCounter, True)
End If
Next rowCounter

MsgBox "Finished"
End Sub