□ 戻る □一般操作のサロン □ 使用方法 □ 新着記事 □ 新規に質問する！ □ トピック一覧 □ 検索 □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
| 最終行まで貼り付け後隣も同じ処理をするには？ | |
|---|---|
[194996] 最終行まで貼り付け後隣も同じ処理をするには？- ■親トピック/記事引用/メール受信=OFF■ □投稿者/ 清水 -(2022/06/14(16:37)) □U R L/ 皆様、いつもお世話になっております。
以前、こちらで教えて頂いたマクロがあります。
Sub 下まで値の貼り付け()
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("B2:B" & LastRow).FillDown
Range("B3:B" & LastRow).Copy
Range("B3:B" & LastRow).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End Sub
こちらの処理だと、Ｂ列のみになります。
これと同じ処理を『1列づつ』
Ｂ列を２列目とした場合
８列目のＨ列まで処理するには、どの様に書けば良いでしょうか？
よろしくお願い致します。
この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[195000] Re[1]: 最終行まで貼り付け後隣も同じ処理をするには？- ■記事引用/メール受信=OFF■ □投稿者/ たんじゅん -(2022/06/15(07:50)) □U R L/ 同じように記述するだけでいいと思いますが、難しかったですか？
Sub 下まで値の貼り付け2()
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("B2:B" & LastRow).FillDown
Range("B3:B" & LastRow).Copy
Range("B3:B" & LastRow).PasteSpecial Paste:=xlValues
Range("C2:C" & LastRow).FillDown
Range("C3:C" & LastRow).Copy
Range("C3:C" & LastRow).PasteSpecial Paste:=xlValues
Range("D2:D" & LastRow).FillDown
Range("D3:D" & LastRow).Copy
Range("D3:D" & LastRow).PasteSpecial Paste:=xlValues
Range("E2:E" & LastRow).FillDown
Range("E3:E" & LastRow).Copy
Range("E3:E" & LastRow).PasteSpecial Paste:=xlValues
Range("F2:F" & LastRow).FillDown
Range("F3:F" & LastRow).Copy
Range("F3:F" & LastRow).PasteSpecial Paste:=xlValues
Range("G2:G" & LastRow).FillDown
Range("G3:G" & LastRow).Copy
Range("G3:G" & LastRow).PasteSpecial Paste:=xlValues
Range("H2:H" & LastRow).FillDown
Range("H3:H" & LastRow).Copy
Range("H3:H" & LastRow).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End Sub
この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[195001] Re[2]: 最終行まで貼り付け後隣も同じ処理をするには？- ■記事引用/メール受信=OFF■ □投稿者/ ねむねむ -(2022/06/15(09:57)) □U R L/ 通常であれば
Sub 下まで値の貼り付け()
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("B2:H" & LastRow).FillDown
Range("B3:H" & LastRow).Copy
Range("B3:H" & LastRow).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End Sub
となるが
>これと同じ処理を『1列づつ』
ということであれば
Sub 下まで値の貼り付け()
Dim LastRow As Long
Dim Loop_Cnt As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For Loop_Cnt = 2 To 8
' Range("B2:H" & LastRow).FillDown
Range(Cells(2, Loop_Cnt), Cells(LastRow, Loop_Cnt)).FillDown
' Range("B3:H" & LastRow).Copy
Range(Cells(3, Loop_Cnt), Cells(LastRow, Loop_Cnt)).Copy
' Range("B3:H" & LastRow).PasteSpecial Paste:=xlValues
Range(Cells(3, Loop_Cnt), Cells(LastRow, Loop_Cnt)).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Next
End Sub
だろうか？この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[195002] Re[3]: 最終行まで貼り付け後隣も同じ処理をするには？- ■  / 記事引用/メール受信=OFF■
□投稿者/ 清水 -(2022/06/16(07:31)) □U R L/ たんじゅんさん、ねむねむさん こんにちは お返事ありがとうございます。 たんじゅんさんの方法も考えたのですが、 それ以外のコードの書き方が知りたかったので質問したしましたが、 説明不足で、大変申し訳ございませんでした。 ねむねむさん、分かりやすく1行毎にコメントまで大変感謝致します。 あと、変数もとても分かりやすくして頂き嬉しいです。 お陰様で新たな書き方を学ぶ事が出来ました。 そして、使わせて頂きます。 いつも、本当にありがとうございます。 | |