人に聞けない痔の悩み、これでスッキリ >>

こんにちは
条件に合う文字列があった場合に該当するシートへ順番にセルをコピーをしたいです。
調べながら作成したものではうまくいかず、皆様の知識をお借りしたいと思い投稿させて頂きました。
目的:シート”dddd”の1列目6行目以下~を参照し
①aaaaがあった場合はシートaaaaの2列目8行目から順に転記
⓶bbbbがあった場合はシートbbbbの〃
③ccccがあった場合はシートccccの〃
を行いたいと考えています。(操作はシートddddで行っています)
色々見ながら下記で操作したところ繰り返し作業が行われない状態でどの様にしたら良いかわからず
投稿させて頂きました。 お手数ですがご指摘アドバイスなど宜しくお願い致します。
Sub tenki3()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim i As Variant
Dim j As Variant

Set ws1 = Worksheets("aaaa")
Set ws2 = Worksheets("bbbb")
Set ws3 = Worksheets("cccc")
Set ws4 = Worksheets("dddd")

lRow = ws4.UsedRange.Rows.Count

For i = 6 To Cells(Rows.Count, 1).End(xlUp).Row
j = 8

If Cells(i, 1) = "aaaa" Then
ws1.Cells(j, 1) = ws4.Cells(i, 2)

End If
j = 8 + 1
Next i

End Sub

A 回答 (4件)

No.2です。



>転記先のセルを8行目にするためには・・・
というコトですが、前回投稿した中に
>(各シートのA7セルには項目名が入っている!という前提です)
という大前提がありましたよね。

>wS.Cells(Rows.Count, "A").End(xlUp).Offset(1) = .Cells(i, "B")
でA列の最終行の一つ下のセルに順に該当データを表示するようにしていますので、
A7セルに項目など何らかのデータがないととんでもないところに表示されてしまいます。

A7セルに何もデータがない場合は変数を一つ増やして
行を指定するしかないかも・・・m(_ _)m
    • good
    • 0
この回答へのお礼

なるほど、再度のご回答有難うございます。
再度色々試してみます。
ご丁寧に教えて頂き有難うございました。

お礼日時:2020/08/12 09:25

こんにちは、


すでに回答が出ていますが、参考までにオートフィルタの場合のサンプルです。
Sub Sample3()
  Dim lRow As Long
  Dim keyword
  With Worksheets("dddd")
    lRow = .UsedRange.Rows.Count
    For Each keyword In Array("aaaa", "bbbb", "cccc")
      If Application.CountIf(.Range("A6:A" & lRow), keyword) > 0 Then
        .UsedRange.AutoFilter Field:=1, Criteria1:=keyword
        .Range("B6:B" & lRow).SpecialCells(xlCellTypeVisible).Copy Sheets(keyword).Range("B8")
        .AutoFilterMode = False
      End If
    Next
  End With
End Sub
セルの書式もコピーされます。
値のみの場合は、PasteSpecialメソッドの Paste:=xlPasteValues
Application.CutCopyMode = False
に変更、追加してください。
    • good
    • 0
この回答へのお礼

ご回答有難うございます。
オートフィルタにて作成してみたところ、書式が違うためコピーできないと出てしまうため現在奮闘中です。
御教授頂き有難うございました。

お礼日時:2020/08/12 09:23

こんにちは!



余計なお世話かもしれませんが・・・
>(操作はシートddddで行っています
とありますが、「dddd」シートのシートモジュールにしているのでしょうか?

複数のシートにわたって操作する場合は「標準モジュール」にした方がエラーが少ないと思います。
(もちろん、シートモジュールでもエラーなく動くことも多くあります)

さて本題ですが、「dddd」シートのA列には各シート名が入っているのでしょうかね。

一例です。
(各シートのA7セルには項目名が入っている!という前提です)

Sub Sample1()
 Dim i As Long, k As Long
 Dim wS As Worksheet
 Dim myFlg As Boolean
 Dim myAry

  myAry = Array("aaaa", "bbbb", "cccc")
   With Worksheets("dddd")
    For i = 6 To .Cells(Rows.Count, "A").End(xlUp).Row
     For k = 0 To UBound(myAry)
      If .Cells(i, "A") = myAry(k) Then
       myFlg = True
       Exit For
      End If
     Next k
      If myFlg = True Then
       Set wS = Worksheets(myAry(k))
        wS.Cells(Rows.Count, "A").End(xlUp).Offset(1) = .Cells(i, "B")
      End If
       myFlg = False
    Next i
   End With
End Sub

※ データ量が多い場合は、No.1さんが回答されている
オートフィルタの方が速いかも・・・m(_ _)m
    • good
    • 0
この回答へのお礼

tom04様
とてもまとまった式を記載していただき有難うございます。
ご指摘の通り標準モジュールにて運用予定です。
1点ご質問させて下さい。 記載していただいた内容にて動作致しましたが、転記先のセルを8行目にするためにはどうしたらよいでしょうか?
ご質問ばかりで申し訳ありません。 
(記載内容のなかで色々試してみましたが触れば触るほど動作しなくなって
しまいました)

お礼日時:2020/08/06 18:16

どのシートへの値が見つかってもそうでなくても変数:j はドンドン加算されていきますしね。



http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …

オートフィルタを使い1つの値で抽出しそのシートにコピペ。
一旦解除して次の値で同様に、更に次の値でって感じでやっては如何でしょう。
フィルタをかける位置・貼り付ける位置に注意していけば可能な気もしますよ。
過去の質問でもいくつかはあると思いますし。(Autofilterで検索してみると)
    • good
    • 0
この回答へのお礼

ご助言ありがとうございます。
サイトも参考にして取り組んでみます

お礼日時:2020/08/06 10:37

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング