Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4270 / 76734

←次へ　｜　前へ→


	【78089】Re:VBAで「リンク貼り付け」をしたい

マナ - 16/4/2(土) 10:43 -


	引用なし

	パスワード

▼かなさん：
毎回、シートを作り直しています。
シート名が不適切でエラーとなる場合もあるかもしれません。

Sub シート分け2()
　　Dim ws As Worksheet
　　Dim n As Long
　　 Dim h As Range
　　
　　With Worksheets("一覧表")
　　　　Application.DisplayAlerts = False
　　　　For Each ws In Worksheets
　　　　　　If ws.Name <> .Name Then ws.Delete
　　　　Next
　　　　Application.DisplayAlerts = True
　　　　
　　　　n = .Range("A1").CurrentRegion.Columns.Count
　　　　
　　　　'転記する
　　　　For Each h In .Range("H7:H" & .Range("H65536").End(xlUp).Row)
　　　　　　Set ws = Nothing
　　　　　　On Error Resume Next
　　　　　　Set ws = Worksheets(h.Value)
　　　　　　On Error GoTo 0
　　　　　　If ws Is Nothing Then
　　　　　　　　'支店名シートを新調する
　　　　　　　　Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　　　　　　ws.Name = h.Value
　　　　　　　　.Rows(1).Resize(, n).Copy ws.Range("A3")
　　　　　　End If
　　　　　　ws.Range("H65536").End(xlUp).EntireRow.Resize(, n).Offset(1).Formula = _
　　　　　　　　"=" & h.EntireRow.Range("A1").Address(False, False, , True)
　　　　　　
　　　　Next
　　End With

End Sub

7 hits

▼

【78084】VBAで「リンク貼り付け」をしたい かな 16/4/1(金) 18:22