複数シートの複数列に入力されているデータを重複なしで抽出するVBAを作りたいです。

シート１　　　シート２
A列　　　　　 A列
AAA　　　　　AAA
BBB　　　　　BBB
CCC　　　　　DDD
AAA　　　　　CCC
↓
シート３
A列
AAA
BBB
CCC
DDD

上記のように複数シートに入力されているデータを別のシートに重複なしで抽出するVBAを作りたいので、お知恵を貸して頂きたいです。
VBA初心者ですので、ご迷惑をおかけするとは思いますが、よろしくお願いします。

ちなみに
単一の列を同じシートの列に抽出するVBAはネットで探して成功しました。
それが以下のコードです。

Sub リスト作成()
Dim A As New Collection, i As Long
On Error Resume Next
For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
A.Add Cells(i, 3), Cells(i, 3)
Next i
On Error GoTo 0
For i = 1 To A.Count
Cells(i + 2, 6) = A(i)
Next i
End Sub

質問者からの補足コメント

• 回答していただき、ありがとうございます。
  その方法は各シートにあらかじめ、データがどのくらい入っているかが分かっていればできると思います。
  できれば知識がない人でもボタン１つでできるようにVBAで探しています。

  No.1の回答に寄せられた補足コメントです。 補足日時：2022/06/17 10:47

• 回答していただき、ありがとうございます。
  
  その方法だと、データをコピーして貼り付ける場所がデータ量によって異なりませんか？
  また、余談の件ですが私は「分からない問題に対して答えを教えてもらう場所」だと認識しています。
  学校であれば、次回からできるようにするが目的かもしれませんが、私はそうではありません。

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/06/17 11:02

• 質問はあくまでも例として挙げさせて頂きました。
  実際は
  シート１、２はC列の３行目から始まっています。
  シート３はB列の４行目から始まっています。
  
  宜しくお願いいたします。

  No.7の回答に寄せられた補足コメントです。 補足日時：2022/06/17 12:23

No.8 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/06/17 12:45

以下のマクロを標準モジュールに登録してください。

Option Explicit

Dim sh3 As Worksheet
Dim dicT As Object
Dim row3 As Long

Public Sub 重複無()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow3 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
maxrow3 = sh3.Cells(Rows.Count, "B").End(xlUp).Row 'B列最終行を求める
sh3.Range("B4:B" & maxrow3).ClearContents 'B列４行以降をクリア
row3 = 4
Call シート3出力(sh1)
Call シート3出力(sh2)
MsgBox ("完了")
End Sub

Private Sub シート3出力(ByVal ws As Worksheet)
Dim maxrow As Long
Dim wrow As Long
Dim key As String
maxrow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'A列最終行を求める
For wrow = 3 To maxrow
key = ws.Cells(wrow, "A").Value
If key <> "" Then
If dicT.exists(key) = False Then
dicT(key) = True
sh3.Cells(row3, "B").Value = key
row3 = row3 + 1
End If
End If
Next
End Sub

No.9 回答者： めぐみん_ 回答日時： 2022/06/17 15:18

質問はあくまで重複をなくすことではありますが、実際には重複に絡むデータ列が存在しているとかでは？

とまずは気になりますね。

その重複削除した際にデータを追従させる手段も悩まれてたりはしませんか？
⇒セル範囲の取得法など。

違ってたらスル～して下さいな。

No.7 回答者： tatsumaru77 回答日時： 2022/06/17 12:19

補足要求です。

１．シート１のA列のデータは、１行目から開始していますか。
それとも、１行目は見出しで、データは２行目からでしょうか。
２．シート２のA列についても、同様です。

No.6 回答者： fujillin 回答日時： 2022/06/17 12:17

こんにちは

説明にはA列と書いてあって、コードでは3列目（=C列）をいじくっているように見えるけれど、本当のところは何をなさりたいのでしょうか？

＞貼り付ける場所がデータ量によって異なりませんか？
VBAなんだから、調べれば良いだけ。

なさりたいことがよくわからないので、勝手に妄想してみました。
（当たるも八卦ですが、A列を集約します）
・「指定シートが存在しない」など、エラーチェックは一切行省いてあります。

Sub Q13000652()
Dim sh As Worksheet, rg As Range
Dim rw As Long, sName
With Worksheets("Sheet3")
.Columns(1).ClearContents
Set rg = .Cells(1, 1)

For Each sName In Array("Sheet1", "Sheet2")
Set sh = Worksheets(sName)
rw = sh.Cells(Rows.Count, 1).End(xlUp).Row
rg.Resize(rw).Value = sh.Cells(1, 1).Resize(rw).Value
Set rg = rg.Offset(rw)
Next sName
.Columns(1).RemoveDuplicates (1)
End With
End Sub

No.5 回答者： KenKen_SP 回答日時： 2022/06/17 12:09

dictionary 重複なし vba

で検索するとサンプル見つかると思いますよ。この用途だとCollectionよりDictionaryの方が分かりやすいです。
頑張って。

No.4 回答者： 銀鱗 回答日時： 2022/06/17 11:07

＞データをコピーして貼り付ける場所がデータ量によって異なりませんか？

(´・ω・`)
1行目に挿入貼り付け…って書かなかったっけ？

No.3 回答者： 銀鱗 回答日時： 2022/06/17 10:55

質問者さんは勘違いされていますね。

データ範囲もVBAで指定するんですよ。

手作業で範囲を指定するとき、何を基準にデータ範囲と判断するか。
それを明確にしてみましょう。
その判断に基づいて ”プログラムを組む” のです。

No.2 回答者： 銀鱗 回答日時： 2022/06/17 10:53

自分もコピーして一覧を作ったうえで重複を削除することを薦めます。

それにそのほうが処理が速い。

データ範囲を指定して複製。
Sheet3の1行目に【挿入貼り付け】。
これをSheet1とSheet2の両方で行った後に、
Sheet3で重複削除。


・・・余談・・・

質問文は
　「これを作り直せ。オレ様の成果として使ってやるｗｗｗ」　
って内容になっていますが、それで間違いないでしょうか。

ここは自力で問題を解決できるようになるためのアドバイスを受ける場所です。
そのマクロを直す中で何が分からないのかをピンポイントで質問するようにしてみましょう。
例：
　「マクロを探してきましたが、解説がないため意味不明です。
　　どなたか解説をお願いします」
　「シートを指定する書き方が分かりません」
など。

No.1 回答者： ys1957 回答日時： 2022/06/17 10:40

各シートの情報をコピーでワークシートに移し　そのシート内でキー項目でソートして重複している項目を消せば？