Help with simplifying code

[tmsmyer]

I've got a bunch of code that I got some from borrowing from other files and some from using the macro recorder. I was hoping to get some help with cutting out any unnecessary portions and condensing it. It mostly consists of a web query and the copying several ranges and pasting the values on other sheets.

Sub Run()


Application.ScreenUpdating = False
Sheets("helper").Visible = True
Sheets("copypaste").Visible = True
Sheets("urls").Visible = True
Sheets("data").Visible = True




Sheets("helper").Range("B5") = Sheets("copypaste").Range("F1")


url1 = Sheets("urls").Range("B1")


Sheets("data").Cells.ClearContents


  Sheets("data").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & url1 _
        , Destination:=Range("A1"))
        .Name = _
        "data"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery = False
    End With


Range("A:A").Select
    Selection.Copy
Sheets("helper").Select
Range("M1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("M:M").RemoveDuplicates Columns:=1, Header:=xlYes


Sheets("copypaste").Activate
Range("B4:B7").Select
    Selection.Copy
Sheets("Main").Activate
Range("D4:D7").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Sheets("copypaste").Activate
Range("B10:B21").Select
    Selection.Copy
Sheets("Main").Activate
Range("D10:D21").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Sheets("copypaste").Activate
Range("E4:E7").Select
    Selection.Copy
Sheets("Main").Activate
Range("G4:G7").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Sheets("copypaste").Activate
Range("E10:E17").Select
    Selection.Copy
Sheets("Main").Activate
Range("G10:G17").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


Sheets("helper").Visible = False
Sheets("copypaste").Visible = False
Sheets("urls").Visible = False
Sheets("data").Visible = False
Application.ScreenUpdating = True


End Sub

 

[MARK858]

A bit tidier but totally untested...

Sub Run()


    Application.ScreenUpdating = False

    Sheets("helper").Visible = True
    Sheets("copypaste").Visible = True
    Sheets("urls").Visible = True
    Sheets("data").Visible = True

    Sheets("helper").Range("B5") = Sheets("copypaste").Range("F1")

    url1 = Sheets("urls").Range("B1")

    Sheets("data").Cells.ClearContents

    With Sheets("data")
        With .QueryTables.Add(Connection:= _
                              "URL;" & url1 _
                              , Destination:=.Range("A1"))
            .Name = _
            "data"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlAllTables
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery = False
        End With
        Sheets("helper").Range("M:M").Value = .Range("A:A").Value
    End With

    Sheets("helper").Range("M:M").RemoveDuplicates Columns:=1, Header:=xlYes

    Sheets("Main").Range("D4:D7").Value = Sheets("copypaste").Range("B4:B7").Value
    Sheets("Main").Range("D10:D21").Value = Sheets("copypaste").Range("B10:B21").Value
    Sheets("Main").Range("D10:D21").Value = Sheets("copypaste").Range("B10:B21").Value
    Sheets("Main").Range("G4:G7").Value = Sheets("copypaste").Range("E4:E7").Value
    Sheets("Main").Range("G10:G17").Sheets("copypaste").Range("E10:E17").Value

    Sheets(Array("helper", "copypaste", "urls", "data")).Visible = False
    
    Application.ScreenUpdating = True

End Sub

 

[tmsmyer]

it works, thanks

 

[MARK858]

it works, thanks

You're welcome