[[20210608200242]]　『マクロの改造』（ギラくん）　ページの最後に飛ぶ

『マクロの改造』（ギラくん）

いつもお世話になります
私のhttps://www.excel.studio-kazu.jp/kw/20210503222756.html
のマクロにいくつか改造したいのですが方法を教えて下さい
１　各シートのa1の文字をp列に表示
２　ファイル名を各シートのq列に表示
で一つにまとめたいのですが
現在のコードは

 Private Sub sh_check()
   Dim newSh As String
   Dim Sh As Worksheet, myFlag As Boolean
     newSh = "全データ"  '---まとめ用のシート名です
     myFlag = False  '---まとめ用のシートが有ったら True /無かったら False にするフラッグです
     For Each Sh In ThisWorkbook.Worksheets
         If Sh.Name = newSh Then
             myFlag = True
             '----全データシートのデータをクリアし、先頭へ移動します
             Worksheets(newSh).Cells.Clear  'ClearContentsではない。(結合セル対策）
             Worksheets(newSh).Move before:=Sheets(1)
             Exit For
         End If
     Next Sh
     '----全データシートを先頭へ追加します
     If myFlag = False Then
         ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh
     End If
 End Sub
と
Sub まとめ改13()

     Dim i As Integer
     Dim stRW As Long
     Application.ScreenUpdating = False
     Call wsnamae
     sh_check '----全データシートの有無をチェックします
     stRW = 1
     For i = 2 To Worksheets.Count
         With Worksheets(i)
             With Application.Range(.Cells(1, 1), .UsedRange)
                 .Cells.Copy
                  Worksheets(1).Cells(stRW, 1).PasteSpecial xlPasteValuesAndNumberFormats
             End With '★ここ★
             With Application.Range(.Cells(1, 1), .UsedRange)
                 .Cells.Copy
                  Worksheets(1).Cells(stRW, 1).PasteSpecial xlPasteFormats
                  stRW = stRW + .Rows.Count
             End With
         End With
     Next i
     Worksheets(1).Activate
END sub
ですよろしくお願いします

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

■１
現状で詰まってるのはどの部部分なのですか？
また、やりたいこともよく理解できません。

１　各シートのa1の文字をp列に表示
→どのシートの、P列の何行目に表示（転記？）したいのですか？

２　ファイル名を各シートのq列に表示
→P列の何行目に表示（記入？）したいのですか？

■２

 '★ここ★

↑はなんで残してるんですが？（前トピックで、そこに「End With」がないのがおかしいと指摘したものですが・・・）

（もこな２） 2021/06/08(火) 22:42

もこな２さん　コメントありがとうございます

 １　各シートのa1の文字をp列に表示
→どのシートの、P列の何行目に表示（転記？）したいのですか？
各シートのa1の文字をp列の４～２２行目に表示したいのですが

２についてもQ列の４～２２行目です

うまく説明できなくてすいません
（ギラくん） 2021/06/08(火) 22:50

結局どこで詰まってるか分かりませんし、１、２、いずれも出力先がよく理解できませんが見切り発車

    Sub 見切り発車()
        Dim i As Long

        For i = 2 To Worksheets.Count

            '【１番目】のシートのP列４行目以降に、【２番目以降】のシートのA1セルの値を書き出し
            Worksheets(1).Cells(i + 2, "P").Value = Worksheets(i).Range("A1").Value

            '【２番目以降】のシートのQ4～Q22セルに自ブック名を書き込み
            Worksheets(i).Range("Q4:Q22").Value = ThisWorkbook.Name
        Next
    End Sub

（もこな２） 2021/06/09(水) 10:38

ありがとうございますためしてみますまた連絡します
（ギラくん） 2021/06/09(水) 17:05

試した動きは概ねよかったのですが

            '【１番目】のシートのP列４行目以降に、【２番目以降】のシートのA1セルの値を書き出し
            Worksheets(1).Cells(i + 2, "P").Value = Worksheets(i).Range("A1").Value

のところが私の説明が下手でした
そうではなく
シート２のa１セルの値をシート２のp列に書き出し
シート３のa１セルの値をシート３のp列に書き出し
以降同様
みたいにしたいです
説明が下手でした申し訳ございません
（ギラくん） 2021/06/09(水) 19:29

＞そうではなく～
なるほど。されたいことはわかりました。
で、どこでつまっているのですか？

ヒントというか、ほぼ答えが「２」にありませんか？

（もこな２） 2021/06/09(水) 20:07

できました

    Sub 見切り発車()
        Dim i As Long

        For i = 2 To Worksheets.Count

            '【１番目】のシートのP列４行目以降に、【２番目以降】のシートのA1セルの値を書き出し
                        Worksheets(i).Range("r4:r22").Value = Worksheets(i).Range("c1").Value

            '【２番目以降】のシートのQ4～Q22セルに自ブック名を書き込み
            Worksheets(i).Range("Q4:Q22").Value = ActiveWorkbook.Name
        Next
    End Sub

でうごきました
ありがとうございました
（ギラくん） 2021/06/09(水) 20:51

もう一つ教えていただけたらと思うことがあって
いま

  '【２番目以降】のシートのQ4～Q22セルに自ブック名を書き込み
            Worksheets(i).Range("Q4:Q22").Value = ActiveWorkbook.Name
        となってますが
開始の行は４行目で良いのですが
終わりの行を可変することは可能でしょうか
つまり
データが１５行しかない場合は１５行目まで
逆に２５行あるデータの場合は２５行目

みたいにしたいです
わかりにくいかもしれませんがよろしくお願いします

（ギラくん） 2021/06/09(水) 22:54

↑書き漏れてました　データの最終行はシートごとにちがいます
（ギラくん） 2021/06/09(水) 23:07

超オーソドックスな方法として、Endプロパティを使った最終行を取得するという方法がありますよ。
https://excel-ubara.com/excelvba1/EXCELVBA318.html
http://www.niji.or.jp/home/toru/notes/8.html
http://officetanaka.net/excel/vba/tips/tips130.htm

（もこな２） 2021/06/09(水) 23:22

みましたが　どう指定したら良いかよくわかりません　すいませんが教えていただけたら助かります
よろしくお願いします
（ギラくん） 2021/06/10(木) 17:30

わかったかも知れませんまた書きます
（ギラくん） 2021/06/11(金) 09:54

すいませんデータの最終行の取得の仕方はわかったのですが
範囲指定のやり方がわかりません

すいませんが教えて下さい
よろしくお願いします
（ギラくん） 2021/06/11(金) 20:14

いくつかやり方はありますが

 Worksheets(i).Range("r4:r" & 最終行).Value = Worksheets(i).Range("c1").Value

みたいにしたらどうですか？

（もこな２） 2021/06/11(金) 20:33

つまり最終行という変数で最終行を求めるやり方ですか
（ギラくん） 2021/06/11(金) 20:52

できました

    Sub 見切り発車()
        Dim i As Long
Dim 最終行
        For i = 1 To Worksheets.Count
Call wsnamae
最終行 = Range("C3").End(xlDown).Row
            '【１番目】のシートのP列４行目以降に、【２番目以降】のシートのA1セルの値を書き出し
                        Worksheets(i).Range("P4:P" & 最終行).Value = Worksheets(i).Range("c1").Value
これでううごきました
ありがとうございます

（ギラくん） 2021/06/11(金) 22:45

コメント返信：

[ 一覧(最新更新順) ]

[[20210608200242]] 『マクロの改造』（ギラくん） ページの最後に飛ぶ

[[20210608200242]]　『マクロの改造』（ギラくん）　ページの最後に飛ぶ