CODEWITHSUNDEEP
vbaexcel
Jan Vondra
Jan Vondra

Reputation: 11

Repeating Excel Macro Command 1000 rows

I have 1000 rows in sheet and have this macro:

Sub ares()

Application.ScreenUpdating = False 'potlačí obnovování obrazovky
Application.DisplayAlerts = False 'potlačí varovné hlášky

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"
Sheets("ares").Activate 'přesun na tento nový list

'XML dotaz do ARESU s tím, že ičo máme na první listu v buňce C2 a importovná data chceme vložit do buňky A1
ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range("C2").Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

Sheets(1).Activate 
Sheets(1).Range("A2") = Sheets("ares").Range("AK3") 
Sheets("ares").Delete 'smazání pomocného listu

Application.ScreenUpdating = True 'zapne obnovování obrazovky
Application.DisplayAlerts = FaTruelse 'obnoví varovné hlášky

End Sub

I would like to repeat this task over the range of 1000 rows, instead of what is shown above.

Upvotes: 0

Views: 71

Answers (2)

Jan Vondra
Jan Vondra

Reputation: 11

This is tested. Thanky you

Sub ares()





For i = 14 To 17
    Application.ScreenUpdating = False 'potlací obnovování obrazovky
    Application.DisplayAlerts = False 'potlací varovné hlášky
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"
    Sheets("ares").Activate 'presun na tento nový list
    ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range("C" & i).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

    Sheets(1).Range("D" & i) = Sheets("ares").Range("AK3")

    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("ares").Delete 'smazání pomocného listu
    Application.ScreenUpdating = True 'zapne obnovování obrazovky
    Application.DisplayAlerts = True 'obnoví varovné hlášky
Next i






End Sub

Upvotes: 1

John Muggins
John Muggins

Reputation: 1198

This is untested:

Sub ares()

Application.ScreenUpdating = False 'potlací obnovování obrazovky
Application.DisplayAlerts = False 'potlací varovné hlášky

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"
Sheets("ares").Activate 'presun na tento nový list

For i = 2 To 1002
    ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range("C " & i).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

    Sheets(1).Range("A" & i) = Sheets("ares").Range("AK3")

    Cells.Select
    Selection.ClearContents
    Range("A1").Select
Next i


Sheets("ares").Delete 'smazání pomocného listu

Application.ScreenUpdating = True 'zapne obnovování obrazovky
Application.DisplayAlerts = True 'obnoví varovné hlášky

End Sub

Upvotes: 0

Related Questions