Need help Importing Data using web query to specific Columns

I am sending you a file raghava main.xls.
see sheet1. it has the member ship numbers form A2 to A6
After running the macro "test" you get the sheets whose names are the remember ships numbers (same as A2 to A6 in sheet1). see those new member sheets.; I agree some cosmetic changes have to ;be done. let us think about it later. but do you not want some thing like this.


suppose you are generally satisfied with the sheet 1170 to 1175 then for RETESTING
you run the second macro "undo" first and then run the first macro "test" and see whether you get the same result

Note: as you are downloading data and rearranging it it may take some time. for these six members it takes about 20 seconds. that is about 3.5 second for each member). if you have 30 members it will take little less than 2 minutes. keep this in mind.At end of the running the macro "test" you get confirmation message "macro over"

the macros are in vb editor of the file. still I am giving the macro here also

Sub test()
Dim url As String, memurl As String, r As Range, c As Range, dest As Range
Application.ScreenUpdating = False
Worksheets("sheet1").Activate
Set r = Range(Range("a2"), Range("A2").End(xlDown))
url = "http://delhichamber.co.in/ListingDetails.asp?MemID="
For Each c In r
memurl = url & c.Value
'MsgBox memurl
Worksheets.Add
ActiveSheet.Name = c.Value
 With ActiveSheet.QueryTables.Add(Connection:="URL;" & memurl, Destination:=Range("A1"))
        .Name = "ListingDetails.asp?MemID=1770"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """FormPaddingL"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
        '---------------
        With ActiveSheet
       Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(5, 0)
       .UsedRange.Copy
       dest.PasteSpecial , Transpose:=True
       Range(.Range("A1"), dest.Offset(-1, 0)).EntireRow.Delete
        
    End With
    
Worksheets("sheet1").Activate
    
Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "macro over"
End Sub

	


















	
Sub undo()
Dim j As Integer, k As Integer
Application.DisplayAlerts = False
j = Worksheets.Count
For k = j To 1 Step -1
If Left(Worksheets(k).Name, 5) = "Sheet" Then GoTo nextk
Worksheets(k).Delete
nextk:
Next k
Application.DisplayAlerts = True
End Sub


 

Thanks Venkat. I appreciate your reply. I`ll go through the file once I am on my desk and if I still get a problem i`ll get back to u.
Thanks again.