[[20221204184519]] 『列をコピーして行へ横並びに貼り付けたい』(くー) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『列をコピーして行へ横並びに貼り付けたい』(くー)

Sheet(1)の列B5〜最終行の日付をコピーして、Sheet(2)のC列へ貼り付ける下記マクロを変更して、貼付け先をC2〜横並びにしたいのですがどのようにしたらよいか教えてください。
Sub test1()
'日付抽出
Dim i As Long
Dim LastRow As Long
Dim Cnt As Long

    '最終行を取得
    Worksheets(1).Select
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    '転記開始行
    Cnt = 1
    Application.ScreenUpdating = False
    '1〜最終行までループ
    For i = 1 To LastRow
        'B列が空白じゃなければ
        If Cells(i, 2) <> "" Then
            'C列に転記
            Worksheets(2).Cells(Cnt, 3) = Cells(i, 2)
            '転記開始行を更新
            Cnt = Cnt + 1
        End If
    Next i
     Application.ScreenUpdating = True
End Sub

< 使用 Excel:Office365、使用 OS:Windows10 >


2,3+cnt

(隠居Z) 2022/12/04(日) 19:20:42


空白以外の行を抽出して、C列に貼り付け
(B5から〜とあるが、提示コードは1行目から始まっているので、使用する場合は実際の表に合わせて修正してください。下記コードはB1セルに見出しがあることが前提です)

 Sub test2()
     Dim ws1 As Worksheet, ws2 As Worksheet
     Dim LastRow As Long
     Set ws1 = Worksheets(1)
     Set ws2 = Worksheets(2)
     LastRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row
     With ws1.Range("B1").Resize(LastRow)
         .AutoFilter 1, "<>"
         .Copy ws2.Range("C1")
         .AutoFilter
     End With
 End Sub
(フォーキー) 2022/12/04(日) 20:06:08

2,3+cnt ?
(?) 2022/12/04(日) 20:24:36

m(__)m
(隠居Z) 2022/12/04(日) 20:31:39

 列B5〜だったら
 For i = 1 To LastRow → i = 5 です。

 '転記開始 → 開始列に置き換えれば済みます。
 変更した部分
 Cnt = 1 → Cnt = 3 C列
 Cells(Cnt, 3) → Cells(2, Cnt) C2「Cells(2, 3)」
 Cells の書式は(行、列)になっているので逆にする。

 Sheet1 列B5〜
     |[A]|[B]       |[C]
 [1] |   |          |   
 [2] |   |          |   
 [3] |   |          |   
 [4] |   |          |   
 [5] |   |2022/12/1 |   
 [6] |   |2022/12/2 |   
 [7] |   |2022/12/3 |   
 [8] |   |2022/12/4 |   
 [9] |   |2022/12/5 |   
 [10]|   |2022/12/6 |   
 [11]|   |2022/12/7 |   
 [12]|   |2022/12/8 |   
 [13]|   |2022/12/9 |   
 [14]|   |2022/12/10|   
 [15]|   |          |   
 [16]|   |          |   
 [17]|   |          |             

 Sheet2
    |[A]|[B]|[C]      |[D]      |[E]      |[F]      |[G]      |[H]      |[I]      |[J]      |[K]      |[L]       |[M]
 [1]|   |   |         |         |         |         |         |         |         |         |         |          |   
 [2]|   |   |2022/12/1|2022/12/2|2022/12/3|2022/12/4|2022/12/5|2022/12/6|2022/12/7|2022/12/8|2022/12/9|2022/12/10|   
 [3]|   |   |         |         |         |         |         |         |         |         |         |          |   

 >C2〜横並びにしたいのですがどのようにしたらよいか
 こういうことですよね。

(hu) 2022/12/04(日) 20:45:27


 >C2〜横並びにしたいのですがどのようにしたらよいか
 見落としてました。

 huさんの回答で解決したとおもいますが、一応修正バージョンあげときます。参考にでも。

 Sub test2()
     Dim ws1 As Worksheet, ws2 As Worksheet
     Dim LastRow As Long
     Set ws1 = Worksheets(1)
     Set ws2 = Worksheets(2)
     LastRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row
     With ws1.Range("B5").Resize(LastRow)
         .AutoFilter 1, "<>"
         .Copy
         ws2.Range("C2").PasteSpecial xlPasteAll, Transpose:=True
         .AutoFilter
     End With
 End Sub

(フォーキー) 2022/12/04(日) 20:58:46


huさんありがとうございます。お示しいただいた図の通りです。

(くー) 2022/12/04(日) 21:48:11


フォーキーさん 初心者の私にわかりやすいコードのご提示ありがとうございます。こちらで運用させていただきます。
みなさん ありがとうございました。
(くー) 2022/12/04(日) 22:07:02

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.