请将sheet1中的全部网址内容复制粘贴到其它sheet中

SYSMEX530

请将sheet1中的全部网址内容复制粘贴到其它sheet中，一个网址对应一个SHEET。

SYSMEX530

我自己写的，循环没有学好，怎么写也写不下去 了，请老师帮我改一下。


Sub a()
Dim ie1 As Object, url As String, i As Long, n As Long，k%, z%



Cells.NumberFormat = "@"
Set ie1 = UserForm1.WebBrowser1

For n = 2 To [a65536].End(3).Row
   url = Cells(n, 1).Value

k = Sheets.Count
ReDim arr(1 To k)
    For z = 1 To k
        arr(z) = Sheets(z).Activate
next

   With ie1
     .Navigate url
     Do Until .ReadyState = 4
       DoEvents
     Loop

   
        .Document.body.Focus
        .Document.execCommand "SelectAll"
        .Document.execCommand "copy"
        Range("e1").Select
        ActiveSheet.Paste

   
   End With
Next

Set ie1 = Nothing

End Sub

LIUZHU

总共7个网址，生成7个Sheet吗？为什么有160多个空白工作表？

SYSMEX530

列举了7个，最多有30多个呢
麻烦老师帮我看看我的代码，循环出错

SYSMEX530

列举了7个，最多有30多个呢
麻烦老师帮我看看我的代码，循环出错

SYSMEX530

列举了7个，最多有30多个呢
麻烦老师帮我看看我的代码，循环出错

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, j&
   
    Application.DisplayAlerts = False
   
    ar = [A1].CurrentRegion.Value
    For j = Sheets.Count To 2 Step -1
        Sheets(j).Delete
    Next j
   
    For i = 1 To UBound(ar)
        With Sheets.Add(after:=Sheets(Sheets.Count))
            .[A1].Value = ar(i, 1)
        End With
    Next i
   
    Application.DisplayAlerts = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。

shiruiqiang

还以为需要网抓这些网址内的内容哪

SYSMEX530

shiruiqiang 发表于 2024-4-1 22:04
还以为需要网抓这些网址内的内容哪

就是要抓取网址内容的