[[20230620075612]] 『E列の文字を右のシートに順番に転記したい』(take) ページの最後に飛ぶ

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

 

『E列の文字を右のシートに順番に転記したい』(take)

 先週はありがとうございました。
 無事業務が進められています。

 ただ、また次の壁に当たってしまいました。

 Sheet1のE列に文字が入力されています。(複数行で行数は変動します)
 この内容を1行ずつ別シートに転記したいのです。
 (20行あれば20シートに転記する)
 エラーは出ませんが、転記もされません。
 何が足りていないのでしょうか?
 宜しくお願い致します。

 Sub E列を各シートに転記()

 Application.ScreenUpdating = False

 Worksheets("Sheet1").Select

 Dim ファイル名 As Range
 Dim 最終行数 As Long
 Dim シート番号 As Long 
 シート番号 = 2
 シート番号 = シート番号 + 1

 Worksheets("Sheet1").Select

 最終行数 = Cells(Rows.Count, 4).End(xlUp).Row

 For Each ファイル名 In Range("E1:E" & 最終行数 - 1)

 ファイル名.Copy Worksheets(シート番号).Range("B1")

 Next ファイル名

 Application.ScreenUpdating = True

 End Sub

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


E列の最終行。。。
列番号ですが
5では
4はDだったと。^^;
m(__)m
(隠居Z) 2023/06/20(火) 08:10:33

 シート番号 = シート番号 + 1
  ↑は転記処理が終わってから実行するのでは?
(どん) 2023/06/20(火) 08:16:42

(隠居Z) 2023/06/20(火) 08:10:33

違うかもしれません。
他に原因が有るかもしれません。無視して下さい
すみません
m(__)m
(隠居Z) 2023/06/20(火) 08:19:59

隠居Z様
返信いただき、ありがとうございます。
確かにE列は5なのですが、転記させたい行数はD列になります。

念のため、シート番号 = シート番号 + 1
の場所を変えてみましたが、うまくいきませんでした。
こちらこそすみません。
(take) 2023/06/20(火) 08:29:06


 これならどうなりますか?

 Sub E列を各シートに転記()
    Dim ファイル名 As Range
    Dim 最終行数 As Long, シート番号 As Long
    Application.ScreenUpdating = False
    With Worksheets("Sheet1")
        最終行数 = .Cells(.Rows.Count, 5).End(xlUp).Row
        For Each ファイル名 In .Range("E1:E" & 最終行数)
            シート番号 = シート番号 + 1
            ファイル名.Copy Worksheets(シート番号 + 1).Range("B1")
        Next ファイル名
    End With
    Application.ScreenUpdating = True
 End Sub
(あみな) 2023/06/20(火) 08:39:21

 あ、ちなみに転記するシートが、E列行数分無いと
 エラーになります。
(あみな) 2023/06/20(火) 08:40:44

話が進んでいるようですが投稿しておきます。

既に指摘があるようにループのなかで【シート番号】を加算してないからだとおもいますので「ステップ実行」して、おもう通りの命令になっているか自己検証することを強く推奨します。

なお、こだわりがなければインデントを付けることをおすすめします。
たとえば↓のように整理すると何処から何処までがループの中の話なのか把握しやすくなるとおもいます。

 Sub E列を各シートに転記()
     Dim ファイル名 As Range
     Dim シート番号 As Long

     シート番号 = 3
     with Worksheets("Sheet1")
         For Each ファイル名 In .Range("E1" , .Cells(.Rows.Count, 4).End(xlUp).offset(-1,1))
              ファイル名.Copy Worksheets(シート番号).Range("B1")
              シート番号 = シート番号 + 1
         Next ファイル名
     End with
 End Sub

(もこな2) 2023/06/20(火) 08:43:05


>確かにE列は5なのですが、転記させたい行数はD列になります。
E列の行数分転記するんですよね。なぜD列の行数分なんですか。

(SASA) 2023/06/20(火) 08:52:59


あみな様
ありがとうございます。

ファイル名.Copy Worksheets(シート番号).Range("B1")
実行エラー9
インデックスが有効範囲にありません
の表示が出ました
(シートは行数分作成しています)

もこな様
アドバイスをありがとうございます。
ステップ実行はやったことがないのですが
試してみます。

コードに関しては同じく
ファイル名.Copy Worksheets(シート番号).Range("B1")
実行エラー9
インデックスが有効範囲にありません
の表示が出ました

(take) 2023/06/20(火) 08:57:58


SASA様
ありがとうございます。

D列に重複を削除して得られた品目コードがあり
E列にその品目を関数で表示させています。
例えばD列は30行ですが、E列は100行ほど関数が入っています。

欲しいのは、品目コード分のみなので、D列の行数を参照しており
VBAで自動作成したシートもD列を参照しています。

宜しくお願い致します。
(take) 2023/06/20(火) 09:01:58


 >念のため、シート番号 = シート番号 + 1
 >の場所を変えてみましたが、うまくいきませんでした。
 徹底的にそれにこだわって、原因を解明することを推奨します。
 ステップ実行をご存じですか?
 まずはそれを実行して実態をよく観察することです。
 想定どおりにいかないところがあれば、関連する変数の値を確認してください。

 Application.ScreenUpdating = False
 なんて気の利いたことは後回し(正常動作してから)でいいです。デバッグの邪魔です。
 いったんコメントにしておいてください。

 # 追記されたことで、新たに修正すべきところもありますが、あえて言及しません。
 # 最初からトライして下さい。
(xyz) 2023/06/20(火) 09:07:24

 差し当たって、エラーが出たときの シート番号 変数の値を確認していますか?

(xyz) 2023/06/20(火) 09:14:41


xyz様
アドバイスをありがとうございます。
シート番号 変数の値の確認の仕方が分からないので
調べて確認してみます。
(take) 2023/06/20(火) 09:20:32

 検索で

 vba イミディエイトウィンドウ 使い方
 ででてきますよ。

ここが見やすいかな?
https://homestaff.co.jp/vba-immediate-window/
(あみな) 2023/06/20(火) 09:24:47


あみな様
ありがとうございます。
サイトに入ってみました。
↓このような使い方で合っているのでしょうか?

?シート番号 = シート番号 + 1
False

?シート番号 + 1

 1 

(take) 2023/06/20(火) 09:34:13


 あみなさんの
 シート番号 = シート番号 + 1
 Worksheets(シート番号 + 1)
 ループ事に、シート番号が+2されます
 1回目は左端から2シート目
 2回目は左端から4シート目
 もこな2さんの
 シート番号 = 3
 左端から3シート目からコピペするので
 シート数は行数+2必要です
(どん) 2023/06/20(火) 09:38:09

>何が足りていないのでしょうか?

知恵、能力、努力、気概、その他もろもろ。

(言いたい放題) 2023/06/20(火) 09:40:45


皆様
大きな見落としをしていました。
それぞれのシートのB1には何も表示はされていませんが
カーソルを合わせると、E列の式がそのままコピー&ペーストされていました。
今から値貼り付けに変更します
(take) 2023/06/20(火) 10:04:44

ご回答いただいた多くの皆様
貴重なお時間を割いていただき、ありがとうございました。
丸二日悩んでいたので、やっと出口が見えてきました。

ステップ実行やイミディエイトウィンドウ の活用は
今後も続けていきたいと思います。

その他インデントを付ける、徹底的にそれにこだわって、原因を解明する
当貴重なアドバイスもありがとうございました。

言いたい放題様のご指摘も尤もな内容ですので
胸に留めて仕事していきます。

重ね重ねありがとうございました。
(take) 2023/06/20(火) 11:25:38


 もし、出口が見えないようなら...お試しください。

 ちょっと私のマクロで、なぜエラーなのか解らないので
 E列の行数を3行程度にして、下記のマクロを動かすと
 Stop でマクロが止まります。続けて実行すれば動くので
 イミディエイトウィンドウを開いて、睨めっこしながら
 転記シートの状態を確認してください。

 ※新規シートで実験してください。

 ●転記元シート(Sheet1)

    |[E] 
 [1]|E100
 [2]|E101
 [3]|E102

 ●転記シート( 左から順番に、Sheet1 ~ Sheet4 があるとする )

 * Sheet2 の各B1結果 : E100
 * Sheet3 の各B1結果 : E101
 * Sheet4 の各B1結果 : E102

 ●イミディエイトウィンドウ出力結果

 最終行数 3
 転記1回目 : 1
 転記2回目 : 2
 転記3回目 : 3

 Sub E列を各シートに転記()
    Dim ファイル名 As Range
    Dim 最終行数 As Long, シート番号 As Long
'    Application.ScreenUpdating = False
    With Worksheets("Sheet1")
        最終行数 = .Cells(.Rows.Count, 5).End(xlUp).Row
        Debug.Print "最終行数 " & 最終行数
        Stop
        For Each ファイル名 In .Range("E1:E" & 最終行数)
            シート番号 = シート番号 + 1
            Debug.Print "転記" & シート番号 & "回目 : " & シート番号
            ファイル名.Copy
            Worksheets(シート番号 + 1).Range("B1").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            Stop
        Next ファイル名
    End With
'    Application.ScreenUpdating = True
 End Sub

 ※頑張ってください。
 [退場] λ…………トボトボ
(あみな) 2023/06/20(火) 11:52:48

 補足 : 

 イミディエイトウィンドウ出力結果
 シート番号は、+ 1 で考えてください。
(あみな) 2023/06/20(火) 11:56:51

■1
>ステップ実行はやったことがないのですが試してみます。
もしも【ステップ実行】という言葉自体がよくわからないということなら↓を読んでみてください。
 【ステップ実行】
https://www.239-programing.com/excel-vba/basic/basic023.html
http://plus1excel.web.fc2.com/learning/l301/t405.html

また、↓も覚えておいて損はないと思います。

 【ブレークポイント】
https://www.239-programing.com/excel-vba/basic/basic022.html
https://www.tipsfound.com/vba/01010

 【イミディエイトウィンドウ】
https://www.239-programing.com/excel-vba/basic/basic024.html
https://excel-ubara.com/excelvba1/EXCELVBA486.html

 【ローカルウィンドウ】
https://excel-ubara.com/excelvba4/EXCEL266.html
http://excelvba.pc-users.net/fol8/8_2.html

■2
>ファイル名.Copy Worksheets(シート番号).Range("B1")
>実行エラー9
>インデックスが有効範囲にありません
>の表示が出ました

そのままズバリ○番目に該当するシートがないのでしょう。

 あみなさんが指摘済

発想を変えて、決まったシートに貼り付けるのではなく、その都度シートを作成するようにしてはどうですか?

    Sub 研究用()
        Stop 'ブレークポイントの代わり

        Dim 行 As Long
        For 行 = 1 To Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row - 1 Step 1
            Worksheets("Sheet1").Cells(行, "E").Copy
            Worksheets.Add(after:=Worksheets(Worksheets.Count)).Range("B1").PasteSpecial Paste:=xlPasteValues
        Next 行
    End Sub

(もこな2) 2023/06/20(火) 12:58:01


コメント返信:

[ 一覧(最新更新順) ]


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