1.webクエリで表を取得
2.加工
3.別シートに複写
という処理ではなく
1.webクエリで表を取得
2.別シートに個々のセルを複写しながら加工
とした方が楽と思います。
処理後のシートの7行目までは説明がないので
あてずっぽうです。
Option Explicit
Sub Sample()
Dim RowCnt As Long
Dim GetSh As Worksheet
Dim PutSh As Worksheet
Dim PutRow As Long
Set GetSh = ThisWorkbook.Sheets(1)
Set PutSh = ThisWorkbook.Sheets(2)
GetSh.Rows(1).Copy PutSh.Rows(1)
GetSh.Rows(2).Copy PutSh.Rows(2)
GetSh.Rows(3).Copy PutSh.Rows(3)
GetSh.Rows(4).Copy PutSh.Rows(4)
GetSh.Rows(5).Copy PutSh.Rows(5)
PutSh.Cells(4, 3).Value = PutSh.Cells(5, 2).Value
GetSh.Rows(6).Copy PutSh.Rows(5)
GetSh.Rows(8).Copy PutSh.Rows(6)
GetSh.Rows(9).Copy PutSh.Rows(7)
RowCnt = 11
PutRow = 7
Do
If GetSh.Cells(RowCnt, 1).Value = "" Then Exit Do
PutRow = PutRow + 1
PutSh.Cells(PutRow, 1).Value = GetSh.Cells(RowCnt, 1).Value
PutSh.Cells(PutRow, 2).Value = GetSh.Cells(RowCnt, 2).Value
PutSh.Cells(PutRow, 3).Value = GetSh.Cells(RowCnt, 3).Value
PutSh.Cells(PutRow, 4).Value = GetSh.Cells(RowCnt, 5).Value
PutSh.Cells(PutRow, 5).Value = GetSh.Cells(RowCnt, 6).Value
PutSh.Cells(PutRow, 6).Value = GetSh.Cells(RowCnt + 1, 6).Value
PutSh.Cells(PutRow, 7).Value = getMyDay(GetSh.Cells(4, 2).Value)
PutSh.Cells(PutRow, 8).Value = GetSh.Cells(5, 2).Value
RowCnt = RowCnt + 3
Loop
End Sub
Function getMyDay(strdate As String) As String
Dim MyPos As Long
MyPos = InStr(1, strdate, "(") '半角「(」ではなく全角「(」かも
getMyDay = Left(strdate, MyPos - 1)
End Function
補足
getMyDay = Left(strdate, MyPos - 1) の部分で止まってしまいます