Excel VBA-将数据复制到同一工作表时出现问题

Question

I'm trying to read table Values (imported from a URL in Column A) on Sheet1 & then paste the table values on Sheet2, Each underneath the other in the row directly beneath the previously pasted table value in Column B on Sheet2. These pasted row values will usually change each time (always 10 Columns across & a variable # of Rows).

The Code Below will paste each Value 10 Columns over to the right on Sheet2, instead of into Column B (Sheet2), & the correct row.

Any suggestions are much appreciated.

Here are some sample URL's http://hosteddb.fightmetric.com/fighters/details/994 http://hosteddb.fightmetric.com/fighters/details/993

Sub Macro2()

' Macro2 Macro

Dim WSO As Worksheet
Set WSO = ActiveSheet
Dim WS2 As Worksheet: Set WS2 = Worksheets("Sheet2")
NextRow = WS2.Range("A" & Rows.Count).End(xlUp).Row
'ctr = 1

ActiveWorkbook.Worksheets.Add

For Each cell In WSO.Range("A1:A7") 'There are over 2000 values in Column A
ThisURL = "URL;" & cell.Value
Application.CutCopyMode = False
Range("A1").Select
Selection.Copy
Application.CutCopyMode = False
Range("A1").Select
Set WS2 = ActiveSheet
With ActiveSheet.QueryTables.Add(Connection:= _
    ThisURL, Destination:=WS2.Range("A" & NextRow))
    ' Range("A$" & NextRow))    Different variations i've tested
    ' Cells(ctr + 5, 1))        Different variations i've tested
    .Name = "998"
    .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 = "9"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
 'ctr = ctr + 1
 End With

 Next cell
 End Sub

Answer 1

When you insert each new query table from the web, it is inserting columns each time. That's why it kept pushing each added table over to the right. You can use

RefreshStyle=xlOverwriteCells

to keep overwriting the table on a dummy sheet (can even be hidden if needed). In between each overwrite, copy and paste the data from the dummy sheet and put it on your desired output sheet. I've adapted your code above to do just that. It uses Sheet3 as the dummy sheet.

Sub copyFightStats()

Dim wsO As Worksheet
Set wsO = ActiveSheet
Dim ws2 As Worksheet: Set ws2 = Worksheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = Worksheets("Sheet3")
Dim iTableRow As Integer
Dim iTableCol As Integer
Dim iCopyRow As Integer
Dim iURLRow As Integer
Dim sURL As String
Dim xlURLRange As Range
Dim xlCell As Range

iURLRow = wsO.Range("A1").End(xlDown).Row
Set xlURLRange = wsO.Range("A1:A" & iURLRow)

For Each xlCell In xlURLRange 'There are over 2000 values in Column A

    sURL = "URL;" & xlCell.Value
    Application.CutCopyMode = False
    With ws3.QueryTables.Add(Connection:= _
        sURL, Destination:=ws3.Range("A1"))
        .Name = "998"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "9"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
     End With

    'This part grabs the "length" and "width" of the imported data. Tweak this as needed
    iTableRow = ws3.Range("C1").End(xlDown).Row
    iTableCol = ws3.Range("B1").End(xlToRight).Column
    ws3.Range(Cells(1, 2).Address, Cells(iTableRow, iTableCol).Address).Copy

    If ws2.Range("b1").Value = "" Then
       iCopyRow = 1
    Else
       If ws2.Range("b2").Value = "" Then
           iCopyRow = 2
       Else
            iCopyRow = ws2.Range("b1").End(xlDown).Row + 1
       End If
    End If
    ws2.Range("A" & iCopyRow).PasteSpecial xlPasteAll

    'Clear the contents of the previously imported data before importing the next url's data
    ws3.Range(Cells(1, 2).Address, Cells(iTableRow, iTableCol).Address).ClearContents
 Next xlCell
 End Sub

Let me know if that works for you.