Sub CopyAndFillData()
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim sourceDataA As Range
    Dim sourceDataB As Range
    Dim sourceDataD As Range
    Dim sourceDataF As Range
    Dim sourceDataAF As Range
    Dim sourceDataL As Range
    Dim sourceDataX As Range
    Dim sourceDataZ As Range
    Dim sourceDataAA As Range
    Dim sourceDataY As Range
    Dim sourceDataW As Range
    Dim i As Long

     ' Prompt for the source location
    sourceLocation = InputBox("Enter source location (path):")

    ' Prompt for the source file name
    sourceFileName = InputBox("Enter source file name:")

    ' Open the source workbook
    Set sourceWorkbook = Workbooks.Open(sourceLocation & "\" & sourceFileName & ".xlsx")
    ' Set the source sheets
    Set sourceSheet = sourceWorkbook.Sheets(InputBox("Input source sheet name:"))

    ' Create a new target workbook
    Set targetWorkbook = Workbooks.Add

    ' Set a reference to the target worksheet in the new workbook
    Set targetSheet = targetWorkbook.Worksheets(1)


    ' Find the last row in the source sheet
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    ' Set the ranges for data in the source sheet
    Set sourceDataA = sourceSheet.Range("A2:A" & lastRow)
    Set sourceDataB = sourceSheet.Range("B2:B" & lastRow)
    Set sourceDataD = sourceSheet.Range("D2:D" & lastRow)
    Set sourceDataF = sourceSheet.Range("F2:F" & lastRow)
    Set sourceDataAF = sourceSheet.Range("AF2:AF" & lastRow)
    Set sourceDataL = sourceSheet.Range("L2:L" & lastRow)
    Set sourceDataX = sourceSheet.Range("X2:X" & lastRow)
    Set sourceDataZ = sourceSheet.Range("Z2:Z" & lastRow)
    Set sourceDataAA = sourceSheet.Range("AA2:AA" & lastRow)
    Set sourceDataY = sourceSheet.Range("Y2:Y" & lastRow)
    Set sourceDataW = sourceSheet.Range("W2:W" & lastRow)

    For i = lastRow To 2 Step -1
        ' Check for no email address
        If IsEmpty(sourceSheet.Cells(i, 6).Value) Then
            sourceSheet.Rows(i).Delete

        ' Check for valid email address
        ElseIf InStr(1, sourceSheet.Cells(i, 6).Value, "@") = 0 Then
            sourceSheet.Rows(i).Delete
        ' Check for no family name
        ElseIf IsEmpty(sourceSheet.Cells(i, 2).Value) Then
            sourceSheet.Cells(i, 2).Value = sourceSheet.Cells(i, 1).Value
        End If
    Next i

    ' Copy data from source to target
    For i = 2 To lastRow
        targetSheet.Cells(i, 1).Value = sourceDataA.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 2).Value = sourceDataB.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 3).Value = sourceDataD.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 9).Value = sourceDataF.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 7).Value = sourceDataAF.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 10).Value = sourceDataL.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 11).Value = sourceDataX.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 13).Value = sourceDataZ.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 17).Value = sourceDataAA.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 15).Value = sourceDataY.Cells(i - 1, 1).Value
        targetSheet.Cells(i, 18).Value = sourceDataW.Cells(i - 1, 1).Value
    Next i

    ' Fill other specified columns in the target sheet
    For i = 2 To lastRow
        targetSheet.Cells(i, 4).Value = "Valya Krasteva"
        targetSheet.Cells(i, 5).Value = "Ivan Pampulov"
        targetSheet.Cells(i, 6).Value = "Fun Walls, Ropes Course, Rollglider, Adventure Trail, Caving, Cloud Climb, Zip Line, Ninja Course, Tree Course, Slides"
        targetSheet.Cells(i, 8).Value = "Active Entertainment"
        targetSheet.Cells(i, 14).Value = "LinkedIn"
        targetSheet.Cells(i, 19).Value = "I first contacted client"
        targetSheet.Cells(i, 23).Value = "Global"
    Next i

    For i = 2 To lastRow
        ' Check for 'United States' and update to 'USA'
        If targetSheet.Cells(i, 7).Value = "United States" Then
            targetSheet.Cells(i, 7).Value = "USA"
        End If
    Next i

    ' Prompt for the target location and file name
    targetLocation = InputBox("Where should I save it? (path):")
    targetFileName = InputBox("What will be the file name? (without extension):")

    ' Save the target workbook with the specified location and file name
    targetWorkbook.SaveAs targetLocation & "\" & targetFileName & ".xlsx" ' Change the extension if needed

    ' Save the changes to the target workbook
    targetWorkbook.Save
    targetWorkbook.Close SaveChanges:=True
    sourceWorkbook.Close SaveChanges:=False
End Sub