Need help copying cells from one sheet to another..

[JETTLIFE]

paulked - thank you so much again for your continued help with this! You are correct in assuming i needed the data to be shown in a new sheet so then people on my team can name it whatever when they send out to others. I had to make a couple tiny tweaks to make it work though which i highlighted below for anyone to have should this post be useful to them . had 2 bugs, 1) VBA debugger would pop up and alert that there was no sheet named "URL List 1", so i add logic to create the sheet if it doesn't exist in probably the worst way ever considering how streamlined your code is, but hey it works! 2) i had to change the part that deletes the blank rows to column D instead of C because of the new inserted column in A. This works perfect though sir! I also added at the very end a way to delete the temp sheet the vba was using so i dont have two identical tabs. This is sooo freaking fast, i still am dumb founded and impressed how fast you made this script. Thank you like x100!

Sub GetURLs003()    Application.ScreenUpdating = False
    Dim ar As Variant, Meta As String, shMeta As Worksheet, shDest As Worksheet
    Dim i As Long, j As Long, ar1() As Variant, e As Long, lr As Long
    Dim TempSheet As String
    Dim checkSheetName As String
    TempSheet = "URL Temp Sheet"
    'Get source sheet name
    If Len(Range("A6")) < 2 Then
        Meta = InputBox("Please Enter the tab name for your Metadata")
        Range("A6") = Meta
    Else
        Meta = Range("A6")
    End If
    'Check sheet exists
    On Error Resume Next
    Set shMeta = Sheets(Meta)
    On Error GoTo 0
    If shMeta Is Nothing Then MsgBox "That sheet doesn't exist!": Exit Sub
    On Error Resume Next
    checkSheetName = Worksheets(TempSheet).Name
    If checkSheetName = "" Then
        Worksheets.Add.Name = TempSheet
        'MsgBox "The sheet named ''" & TempSheet & _
        '"'' does not exist in this workbook but it has been created now.", _
        'vbInformation, "Intouch SEO Automation for Excel"
         Else
        'MsgBox "The sheet named ''" & TempSheet & _
        '"''exist in this workbook.", vbInformation, "Intouch SEO Automation for Excel"
        'Worksheets(TempSheet).Activate       'Selects worksheet
           'ActiveSheet.UsedRange.Delete                'deletes the used range of cells to clear the sheet
            'Range("a1").Select
    End If
'Set sheet names
    Set shDest = Sheets(TempSheet)
    'Put source int array
    ar = shMeta.UsedRange
    'Loop through data and write to new array ignoring formula errors on data page!
    For i = 8 To UBound(ar, 1)
        For j = LBound(ar, 2) To UBound(ar, 2)
            If LCase(Left(ar(i, j), 10)) = "site page:" Then
                On Error GoTo Nxt
                e = e + 1
                ReDim Preserve ar1(4, e)
                ar1(1, e) = ar(i, j)
                ar1(2, e) = ar(i, j + 1)
            End If
            If LCase(Left(ar(i, j), 8)) = "page url" Then
                On Error GoTo Nxt
                ar1(3, e) = ar(i, j)
                ar1(4, e) = ar(i, j + 1)
            End If
Nxt:
        On Error GoTo -1
        Next
    Next
    On Error GoTo 0
    'Clear destination sheet and write new array
    With shDest
        .Cells.ClearContents
        .Range("A1:E" & UBound(ar1, 2) + 1) = WorksheetFunction.Transpose(ar1)
        'Delete unwanted column
        .Columns("D:D").EntireColumn.Delete
        'Add headers
        .Range("A1") = Format(Now, "m/d/yyyy h:mm:ss AM/PM")
        .Range("B1") = "Page #"
        .Range("C1") = "Page Name"
        .Range("D1") = "Page URL"
        .Range("E1") = "Notes"
        'Delete blank data rows
        lr = .Cells(Rows.Count, 2).End(3).Row
        .Range("D1:D" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    'Add a new sheet and copy new data to it
    With Sheets.Add
        .Name = "URL List" ' & Format(Now, "DD-MMM HH.MM")
        .Tab.Color = vbGreen
        shDest.Range("A1").CurrentRegion.Copy .Range("A1")
        .Columns("A:E").Columns.AutoFit
    End With
    Sheets("URL List").Activate
   'Delete temp sheet
    Application.DisplayAlerts = False
    Worksheets(TempSheet).Delete
    Application.DisplayAlerts = True
End Sub