Sub 複数取得()
i = 1
Do While Sheets("2words").Cells(i, 1) <> ""
myurl = Sheets("2words").Cells(i, 6)
mycat = Sheets("2words").Cells(i, 3)
Worksheets.Add.Name = mycat
Worksheets(mycat).Activate
Cells(1, 1).Value = "印刷会社名"
Cells(1, 2).Value = Sheets("表紙").Cells(1, 2).Value
Cells(2, 1).Value = "印刷方法"
Cells(2, 2).Value = Sheets("表紙").Cells(2, 2).Value
Cells(3, 1).Value = "商品名"
Cells(3, 2).Value = Sheets("表紙").Cells(3, 2).Value
Cells(4, 1).Value = "仕上がりサイズ"
Cells(4, 2).Value = Sheets("表紙").Cells(4, 2).Value
Cells(5, 1).Value = "用紙種類"
Cells(5, 2).Value = Sheets("2words").Cells(i, 1)
Cells(6, 1).Value = "納期"
Cells(6, 2).Value = Sheets("2words").Cells(i, 2)
Cells(7, 1).Value = "ページ数"
Cells(7, 2).Value = Sheets("表紙").Cells(7, 2).Value
Cells(8, 1).Value = "色パターン"
Cells(8, 2).Value = Sheets("表紙").Cells(8, 2).Value
Cells(9, 1).Value = "リンクURL"
Cells(9, 2).Value = myurl
Cells(10, 1).Value = "備考"
Cells(10, 2).Value = ""
With ActiveSheet.QueryTables.Add(Connection:="URL;" & myurl, _
Destination:=Range("A11"))
.Name = mycat
.WebSelectionType = xlSpecifiedTables
.WebTables = "3"
.Refresh
End With
i = i + 1
Loop
End Sub
Sub twowords()
Dim i As Long
Dim myno As Long
'要素1(用紙)のワードの個数を数えます。
Sheets("source").Select
Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Select
myno1 = Selection.Rows.Count
'要素2(納期)のワードの個数を数えます。
Range(Cells(2, 3), Cells(2, 3).End(xlDown)).Select
myno2 = Selection.Rows.Count
'要素の意味の組み合わせを作成します
i = 1
Do While i <= myno1
Sheets("2words").Select
Range(Cells(myno2 * (i - 1) + 1, 1), Cells(myno2 * i, 1)).Value = Sheets("source").Cells(i + 1, 1).Value
Range(Cells(myno2 * (i - 1) + 1, 2), Cells(myno2 * i, 2)).Value = Range(Sheets("source").Cells(2, 3), Sheets("source").Cells(myno2 + 1, 3)).Value
'要素のIDの組み合わせを作成します
Range(Cells(myno2 * (i - 1) + 1, 4), Cells(myno2 * i, 4)).Value = Sheets("source").Cells(i + 1, 2).Value
Range(Cells(myno2 * (i - 1) + 1, 5), Cells(myno2 * i, 5)).Value = Range(Sheets("source").Cells(2, 4), Sheets("source").Cells(myno2 + 1, 4)).Value
i = i + 1
Loop
'シート名とURLを作成します
j = 1
Do While Sheets("2words").Cells(j, 1) <> ""
Sheets("2words").Select
Cells(j, 3).Value = Cells(j, 1) & "_" & Cells(j, 2)
Cells(j, 6).Value = "http://www.graphic.jp/price/" & Sheets("表紙").Cells(3, 4) & "_" & Cells(j, 4) & "_" & Cells(j, 5)
j = j + 1
Loop
End Sub
Sub 余分な行を削除()
Worksheets.Select Replace:=False
Rows("11:11").Select
Selection.Delete Shift:=xlUp