Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7全般 : Excel 2010)
同一ブック内で既存のシートのデータを、新しいシートを作ってそこに貼り付ける。
投稿日時: 17/11/28 10:01:11
投稿者: 1234567890

現在、同一ブック内で、2つの既存シートの該当データ範囲を新しい1つのシートにコピー&ペーストする、というツールを作っています。
 
以下のようにコードを書いたのですが、新しいシートを作れないだけでなくなぜかデータもコピー&ペーストされません。どのようなコードを書けば思ったとおりの結果が出るのか、コードをシェアしていただけないでしょうか?自分はExcelVBA初心者のため、以下のコード以外の例が思いつかないです・・・。
 
Public Sub Copy_Paste()
 
'シートAを定義
Dim SheetA As Worksheet
Set SheetA = ThisWorkbook.Worksheets("Sheet A")
 
'シートBを定義
'Dim SheetB As Worksheet
'Set SheetB = ThisWorkbook.Worksheets("Sheet B")
 
'新しいシートを一枚作る。
Worksheets.Add after:=Worksheets(Worksheets.Count)
 
'Sheet Aの該当範囲をコピー&ペーストする。'Sheet Bはどのようなロジックを書けばいいのか?
Dim startRow As Long
startRow = 1
 
Dim i As Long
i = 2
 
'繰り返し文を全く想像できないです。以下のように書いても、Set文でエラーが起きて動きません。
 
Do While SheetA.Cells(i, 1).Value <> ""
 Set CopiedSheetAData = SheetA.Copy
  
Loop
 
End Sub

回答
投稿日時: 17/11/28 10:31:27
投稿者: bi

Sheet AのA2セルから下方向にデータが入っているところまでを新規に作成したシートにコピーしたいという流れでいいのかな?
 

Public Sub Copy_Paste()
    
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    
    With Sheets("Sheet A")
        .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets(Worksheets.Count).Range("A2")
    End With
 
End Sub

新規シートのどこに貼りつけるかわからないのでとりあえずA2にしてあります。

投稿日時: 17/11/28 10:47:03
投稿者: 1234567890

biさん
 
コードのシェアありがとうございます!
さっそく試してみたところ、動きました。
 
Sheet Aの状態としては、データが入っている箇所はA~AO列となります。
そこから下はエンドレスにデータが入っていくこと(=列は固定だが行がどんどん増えていく)を想定しています。
そのような状態のデータから、C~R列間に入っているすべてのデータを抜き取って、新しいシートにコピペします。

回答
投稿日時: 17/11/28 10:58:16
投稿者: WinArrow
投稿者のウェブサイトに移動

コピーのロジックではありません。
「Sheet B」を作成するところのアドバイスです。
 
>'新しいシートを一枚作る。
>Worksheets.Add after:=Worksheets(Worksheets.Count)
 
このコードでは、新しいシートの名前は「Sheet A (1)」になったままです。
シート名を「Sheet B」に変更するには、次のコードが必要です。
ActiveSheet.Name = "Sheet B"
 

回答
投稿日時: 17/11/28 11:00:16
投稿者: bi

A列からAO列まで最終行はすべて一緒ですか?それとも異なりますか?先ほど1234567890さんが提示したコードではA列を基準としているようですが。

回答
投稿日時: 17/11/28 11:06:50
投稿者: mattuwan44

ども^^
 
Copyメソッドの戻り値は貼付先のセル範囲ではありません。(True or False かな?)
なので、
Setを付けて変数にセル範囲を代入するなんてことはできません。
 
次の貼付先を取得するには、コピー元の大きさを利用してはいかがでしょうか?
 
再度、Copyメソッドのヘルプをご確認ください。
(戻り値の件は詳しく言及がなさそうですが、コピーが成功したか失敗したかが返ってくるだけかなぁ?
まぁ、普通は戻り値を利用することはありませんかね。。。)
 
Public Sub Copy_Paste2()
    Dim shsOld As Sheets
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim ixRow As Long
    Dim v
 
 
    With ThisWorkbook.Worksheets
        'コピー元定義
        Set shsOld = .Item(Array("Sheet A", "Sheet B"))
        'コピー先定義
        Set wsNew = .Add(after:=.Item(.Count))
    End With
 
    ixRow = 1
    For Each ws In shsOld
        With ws.UsedRange
            .Copy wsNew.Cells(ixRow, "A")
            ixRow = .Rows.Count + ixRow
        End With
    Next
End Sub

回答
投稿日時: 17/11/28 11:22:52
投稿者: mattuwan44

あぁ。。。
 
シートごとコピーするのですね。
 
シートのコピーメソッドには戻り値がなさそうなので、
新しいシートは他の方法で取得しないとダメっぽいですかね。
 
ActiveSheetが簡単だけど、何となく使いたくないので、こういう感じかなぁ。。。
少し変かなぁ。。。。
 
 
Public Sub Copy_Paste3()
    Dim rngTo As Range
 
    With ThisWorkbook.Worksheets
        .Item("Sheet A").Copy .Item(.Count)
    End With
     
    With ThisWorkbook.Worksheets
        Set rngTo = .Item(.Count)
    End With
     
    wuth rngTo
        ThisWorkbook.Worksheets("Sheet B").UsedRange.Copy .Cells(.Rows.Count, "A")
    End With
End Sub
 
意外とありそうで考えたことないロジックですね^^
VBA勉強の課題として面白いです^^

投稿日時: 17/11/28 11:43:50
投稿者: 1234567890

WinArrowさん
 
コメントありがとうございます。
Activateというメソッドをここで使うのですね。どうやってSheet Bからデータを抜こうかしばらく考えていてもこれは思いつかなかったです・・・。

投稿日時: 17/11/28 11:46:52
投稿者: 1234567890

 bi さん
 
A~AO列までの最終行の増分は同じになります。
私の頭だと、A列を基準とするしかないと思ったので、A列を基準にしています。
A列を基準としたほうが、後でコードを見たときに分かりやすいかなと思ったので。。

投稿日時: 17/11/28 13:30:14
投稿者: 1234567890

ちなみにbiさんとWinArrowさんからいただいたコードを合わせるとなぜかバグが発生します・・・。
ActiveSheetできちんとシートのありかを指定してるのに、なぜでしょう・・・。
 
Worksheets.Add after:=Worksheets(Worksheets.Count)
     
    'ActivateSheet.Name = "Sheet A"
    With Sheets("Sheet A")
        .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("新シート").Range("A2")
    End With
 
ActiveSheet.Name = "Sheet B"
 
    With Sheets("Sheet B")
        .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("新シート").Range("A2")
    End With
 
End Sub

回答
投稿日時: 17/11/28 13:37:58
投稿者: bi

そのコードだと新シートに貼りつけたSheet Aのデータが上書きされてしまいますよ。
 

Public Sub Copy_Paste()
    
    Dim LastA As Long, LastB As Long
    
    LastA = Sheets("Sheet A").Cells(Rows.Count, 1).End(xlUp).Row
    LastB = Sheets("Sheet B").Cells(Rows.Count, 1).End(xlUp).Row
    
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "新シート"
    
    Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
    Sheets("Sheet B").Range("C2:R" & LastB).Copy Sheets("新シート").Range("A" & LastA + 1)
 
End Sub

投稿日時: 17/11/28 14:47:28
投稿者: 1234567890

biさん
 
そうなのですね・・。データが上書きされる まで想像できなかったです。
しかし、実行時エラー9がまだ出てしまいます。
 
存在するシートとデータ範囲を指定しているのに、なぜインデックスが有効範囲にありません とか言われるのかちょっと不可解です・・・。

回答
投稿日時: 17/11/28 14:56:05
投稿者: bi

実行時エラー9のダイアログが出たときに「デバッグ」を押してみてください。もし
 
LastA = Sheets("Sheet A").Cells(Rows.Count, 1).End(xlUp).Row
LastB = Sheets("Sheet B").Cells(Rows.Count, 1).End(xlUp).Row
 
あたりが黄色になっていたらシート名が違うということになります。
 

投稿日時: 17/11/28 14:58:09
投稿者: 1234567890

biさん
 
実行時エラーのデバッグを押しましたが、黄色くなったのはこの文です。
Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
 
シート名が違う、とは考えづらいです。

回答
投稿日時: 17/11/28 15:08:33
投稿者: bi

うーん、こちらではエラーは出ないのですが。
 
マクロ実行前は1つのブック内に「Sheet A」「Sheet B」の2シートが存在する
マクロを実行すると「Sheet B」の右隣に「新シート」が作成され「Sheet A」「Sheet B」のデータがそれぞれ「新シート」に貼り付けられる
 
という流れで合ってますか?

回答
投稿日時: 17/11/28 15:29:43
投稿者: もこな2

流れをぶった切って、最初の質問でよくわからない部分があるんですが

引用:
同一ブック内で、2つの既存シートの該当データ範囲を新しい1つのシートにコピー&ペーストする、というツールを作っています。
繰り返し文を全く想像できないです。以下のように書いても、Set文でエラーが起きて動きません。
これって
 
前提条件:
 「〜〜〜.Xls」っていうブックの中に「シートA」と「シートB」がある状態。
マクロでやりたいこと:
 @新規シートを追加
 A追加シートの特定箇所に「シートA」の該当範囲をコピー&ペースト
 B追加シートの特定箇所に「シートB」の該当範囲をコピー&ペースト
わからないこと:
 コピー先になる追加したシートをオブジェクトにセットしたいけど方法が不明
 
ってことです?それとも
 
前提条件:
 「〜〜〜.Xls」っていうブックの中に「シートA」というシートを含むいくつかのシートがある状態。
マクロでやりたいこと:
 @「〜〜〜.Xls」っていうブックに新規シートを追加
 A追加シートの名前を「シートB」へ変更
 B「シートB」に「シートA」の該当範囲をコピー&ペースト
わからないこと:
 オブジェクトに「シートB」をセットしたいけどうまくいかない
ってことです?

回答
投稿日時: 17/11/28 15:57:39
投稿者: WinArrow
投稿者のウェブサイトに移動

1234567890 さんの引用:
WinArrowさん
 
コメントありがとうございます。
Activateというメソッドをここで使うのですね。どうやってSheet Bからデータを抜こうかしばらく考えていてもこれは思いつかなかったです・・・。

 
Activateメソッドをアドバイスしたつまりはないですが・・・
なにか、勘違いしていませんか?
 

投稿日時: 17/11/28 16:01:13
投稿者: 1234567890

もこな2さん
 
私の考えていることは、前者の条件一覧になります。
この方法だと実現難しいですかね・・・?

投稿日時: 17/11/28 16:03:12
投稿者: 1234567890

biさん
 
>うーん、こちらではエラーは出ないのですが。
私のPCではエラーが出てしまうのは、環境設定か何かですかね。
  
>マクロ実行前は1つのブック内に「Sheet A」「Sheet B」の2シートが存在する
 マクロを実行すると「Sheet B」の右隣に「新シート」が作成され「Sheet A」「Sheet B」のデータがそれぞれ「新シート」に貼り付けられる
 という流れで合ってますか?
はい、この流れで問題ないです。

回答
投稿日時: 17/11/28 16:15:22
投稿者: bi

新たにブックを作成して「Sheet A」「Sheet B」の2シートを作って適当に数値などを入れてマクロを実行してみてください。もしそれで正常に動くようなら現在使っているブックに問題があるかも?

回答
投稿日時: 17/11/28 16:23:32
投稿者: もこな2

とりあえず、シートを追加してオブジェクトにセットしたいの部分だけ回答するとすれば、こんな感じでしょうか(3番目の方法は実はわたしもよくわかってなかったり。。。。)
 
質問の内容に、コピーしたい範囲(該当範囲)が書かれていないですし、追加シートのどこにコピーしたいのか書かれていないので、コピーに関する回答は入れてないです。
 

Sub sample()

Dim 追加シート As Worksheet

'シートを追加
Worksheets.Add after:=Worksheets(Worksheets.Count)

'お好きな方法でどうそ
    '(シートが追加されたら、追加シートがアクティブになるので)アクティブなシートをオブジェクトにセットしなさい
     Set 追加シート = ActiveSheet

    '(ブックのシートコレクションの最後に追加してるから)最後のシートをオブジェクトにセットしなさい
    Set 追加シート = Worksheets(Worksheets.Count)

    'Addメソッドが「挿入したシート(オブジェクト)を返すという特徴」があることを利用して追加と同時にセットしなさい
    Set 追加シート = Worksheets.Add()

End Sub

回答
投稿日時: 17/11/28 16:30:32
投稿者: baoo

1234567890 さんの引用:
実行時エラーのデバッグを押しましたが、黄色くなったのはこの文です。
Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
&nbsp;
シート名が違う、とは考えづらいです。

こういう場合の考え方として、イミディエイトウィンドウに
?Sheets("Sheet A").Name
と入力してEnterキーを押す。
エラーが発生するなら、そんな名前のシートは存在しません。
そして
?Sheets("新シート").Name
もやっておきましょう。
 
次に同じようにイミディエイトウィンドウに
?LastA
と入力してみる。
0だったらだめですよね。
 
あるいは、その場で
Sub DebugBookSheetName()
    
    Dim wb As Workbook
    Dim sht As Worksheet
    
    For Each wb In Workbooks
        Debug.Print wb.Name
        For Each sht In wb.Worksheets
            Debug.Print " " & sht.Name
        Next
    Next
    
End Sub
を実行してみる。
そしてブック名、シート名が正しいかを確認する。
なんだったらイミディエイトウィンドウに表示されたシート名をコピーして
コピペで実際のシート名に対して名前の変更を実施して貼り付けるとか。
(上記コードではブック名との区別の為にシート名の前にスペースを追加しているので注意)
初心者の方は見た目で同じだと判断するかもしれませんが、
書き慣れた人ならそういう判断はしません。
 
どう見てもシート名が"AAAAAA"にしか見えなくても
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AAA" & vbCrLf & "AAA"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AAA" & vbCr & "AAA"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AAA" & vbLf & "AAA"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AA" & vbCrLf & "AAAA"
として作成されていれば全部別物です。
 
 
 
 

投稿日時: 17/11/28 16:33:25
投稿者: 1234567890

biさん
 
ためしに新しいブックを開いていただいたコードを動かしてみたらエラーもなく動きました。
しかし、Sheet Bのデータが一つもコピーされていないようです。
 
Sheet Aのデータを先にコピペして、その下にSheet Bのデータもコピペしていく というやり方ですよね?

回答
投稿日時: 17/11/28 16:46:58
投稿者: もこな2

ちなみに、提示された以下のコードを読むと

Sub sample()
Worksheets.Add after:=Worksheets(Worksheets.Count) '---------@

ActivateSheet.Name = "Sheet A" '---------------A
With Sheets("Sheet A")
    .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("新シート").Range("A2") '--------B
End With

ActiveSheet.Name = "Sheet B" '--------C
With Sheets("Sheet B")
    .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets("新シート").Range("A2") '--------D
End With
End Sub

@アクティブブックのシートコレクションの最後のシートの後ろにシートを1枚追加しなさい
A(追加してアクティブになっているシートの)名前を「Sheet A」にしなさい
  Excel君< 既存のシート名とかぶってるので、できないんだけど・・・・
B(Aを何とかクリアしたとしても)「Sheet A」に名前を変えたシートのCells(Rows.Count, 1).End(xlUp).Row)を「新シート」の「A2」セルに貼り付けなさい
  Excel君< 「新シート」なんて名前のシートは無いんですが・・・・・・・
C(Bを何とかクリアしたとしても)追加してアクティブになっていて「Sheet A」に名前を変えたシートを「Sheet B」という名前に変えなさい
  Excel君< だから、既存のシート名とかぶってるので・・・・
D(Cを何とかクリアしたとしても)「Sheet B」に名前を変えたシートのCells(Rows.Count, 1).End(xlUp).Row)を「新シート」の「A2」セルに貼り付けなさい
  Excel君< だから「新シート」なんてシートないよ〜〜〜
 
ってエラーになるとおもいます。

回答
投稿日時: 17/11/28 16:49:59
投稿者: bi

1234567890 さんの引用:
Sheet Aのデータを先にコピペして、その下にSheet Bのデータもコピペしていく というやり方ですよね?

その通りなんですけどなぜコピーされないのかさっぱりわかりません。あとSheet Bのデータがコピーされなかったこと以外に問題がないようなのでやっぱ現在使っているブックに問題があるのかも。baooさんの方法(シート名の確認)を試してみてください。

回答
投稿日時: 17/11/28 17:51:53
投稿者: もこな2

biさんが「17/11/28 13:37:58」に投稿されたコードに対してふと思ったのですが、

Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
の.Copyの前ってR1C1形式で記述しているということですよね?
この場合、自分が普段R1C1形式を使ってないのでわからないですけど、絶対参照だったらR1とかC1って省略できるんでしたっけ?
 
また、省略できたとして、LastAが「100」だったら
Sheets("Sheet A").Range("B1:A100").Copy Sheets("新シート").Range("A2")
って意味になるようにおもうんですが、Range("A1:B100")と同じように動くのでしょうか?
(A列とB列の順番が逆でもうごくのかなぁと・・・)

回答
投稿日時: 17/11/28 18:06:56
投稿者: もこな2

1234567890 さんの引用:
biさん
 
ためしに新しいブックを開いていただいたコードを動かしてみたらエラーもなく動きました。
しかし、Sheet Bのデータが一つもコピーされていないようです。
 
Sheet Aのデータを先にコピペして、その下にSheet Bのデータもコピペしていく というやり方ですよね?

念のためですが、「Sheet A」も「Sheet B」も新しいブックにシートコピーして、コピーしたシートそれぞれにはA列とB列にデータが入っていて、マクロを動かしたら、少なくとも「新シート」っていうシートが追加されて「Sheet A」のA1〜B?のデータは「新シート」のA2〜B?+1にコピーされてるんですよね?
 
私が自分でテストしてないのでなんとも言えないですけど、エラーで止まらないことと、目的が達成されていることは別問題なので念のため確認です。

回答
投稿日時: 17/11/28 18:35:40
投稿者: もこな2

何度もすみません。
自分の環境(Win7、Excel2013)で実行してみましたが、やはり「新シート」は作成されましたが、「Sheet A」も「Sheet B」もコピーされなかったので、以下のようにコードを修正したところ目標と思われる動作を確認しました。ご参考まで。

Public Sub Copy_Paste()

    Dim LastA As Long, LastB As Long

    LastA = Sheets("Sheet A").Cells(Rows.Count, 1).End(xlUp).Row
    LastB = Sheets("Sheet B").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "新シート"
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
'    Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
'    Sheets("Sheet B").Range("C2:R" & LastB).Copy Sheets("新シート").Range("A" & LastA + 1)
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
    Sheets("Sheet A").Range("A1:B" & LastA).Copy Sheets("新シート").Range("A2")
    Sheets("Sheet B").Range("A1:B" & LastA).Copy Sheets("新シート").Range("A" & LastA + 2)

End Sub

回答
投稿日時: 17/11/29 08:25:25
投稿者: mattuwan44

Public Sub Copy_Paste2()
    Dim shsOld As Sheets
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim ixRow As Long
  
    With ThisWorkbook.Worksheets
        'コピー元定義
        Set shsOld = .Item(Array("Sheet A", "Sheet B"))
        'コピー先定義
        Set wsNew = .Add(after:=.Item(.Count))
    End With
    '貼付先行番号初期化
    ixRow = 1
    '繰り返す
    For Each ws In shsOld
        'シートの使用しているセル範囲に対して
        With ws.UsedRange
            '操作対象のシートのC:Rをコピーし、新しいシートへ貼付
            Intersect(.Cells, ws.Range("C:R")).Copy wsNew.Cells(ixRow, "A")
            '次の貼付先行番号を用意
            ixRow = ixRow + .Rows.Count
        End With
    Next
End Sub

投稿日時: 17/11/29 11:39:18
投稿者: 1234567890

もこな2 さんの引用:
何度もすみません。
自分の環境(Win7、Excel2013)で実行してみましたが、やはり「新シート」は作成されましたが、「Sheet A」も「Sheet B」もコピーされなかったので、以下のようにコードを修正したところ目標と思われる動作を確認しました。ご参考まで。
Public Sub Copy_Paste()

    Dim LastA As Long, LastB As Long

    LastA = Sheets("Sheet A").Cells(Rows.Count, 1).End(xlUp).Row
    LastB = Sheets("Sheet B").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "新シート"
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
'    Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
'    Sheets("Sheet B").Range("C2:R" & LastB).Copy Sheets("新シート").Range("A" & LastA + 1)
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
    Sheets("
Sheet A").Range("A1:B" & LastA).Copy Sheets("新シート").Range("A2")
    Sheets("Sheet B").Range("A1:B" & LastA).Copy Sheets("新シート").Range("A" & LastA + 2)

End Sub

 
 
もこな2さん
 
うーん、A列やB列だけでなく、SheetAのA-AO列・SheetBのB-S列のデータを行列ごと切り抜いて、新シートにそれらをコピペする のが要件なので、いただいたコードだと新シートにA, B列しかデータがコピペされていないです。。。SheetBの要件が明確でなくてすみません。

回答
投稿日時: 17/11/29 11:51:49
投稿者: bi

1234567890 さんの引用:
SheetAのA-AO列・SheetBのB-S列のデータを行列ごと切り抜いて

Sheet AはC列からR列ですよね?
 
Public Sub Copy_Paste()
    
    Dim LastA As Long, LastB As Long
    
    LastA = Sheets("Sheet A").Cells(Rows.Count, 1).End(xlUp).Row
    LastB = Sheets("Sheet B").Cells(Rows.Count, 1).End(xlUp).Row
    
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "新シート"
    
    Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
    Sheets("Sheet B").Range("B2:S" & LastB).Copy Sheets("新シート").Range("A" & LastA + 1)
 
End Sub

あと私が17/11/28 16:15:22に投稿した内容は試していただけたのでしょうか?
※mattuwan44さんの回答をスルーしているのはなぜなんだろう…

投稿日時: 17/11/29 13:08:00
投稿者: 1234567890

bi さんの引用:
1234567890 さんの引用:
SheetAのA-AO列・SheetBのB-S列のデータを行列ごと切り抜いて

Sheet AはC列からR列ですよね?
 
Public Sub Copy_Paste()
    
    Dim LastA As Long, LastB As Long
    
    LastA = Sheets("Sheet A").Cells(Rows.Count, 1).End(xlUp).Row
    LastB = Sheets("Sheet B").Cells(Rows.Count, 1).End(xlUp).Row
    
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "新シート"
    
    Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
    Sheets("Sheet B").Range("B2:S" & LastB).Copy Sheets("新シート").Range("A" & LastA + 1)
 
End Sub

あと私が17/11/28 16:15:22に投稿した内容は試していただけたのでしょうか?
※mattuwan44さんの回答をスルーしているのはなぜなんだろう…

 
biさんの17/11/28 16:15:22に投稿した内容はトライ済みでここでも言及しましたが・・
mattuwan44さんのコードも一つ一つ今試しているところです。回答までに時間かかる日もあります。スルーしたいわけではないです。

回答
投稿日時: 17/11/29 13:15:40
投稿者: bi

それは失礼しました。
あと17/11/28 16:15:22ではなくこちらでした。
 

bi さんの引用:
1234567890 さんの引用:
Sheet Aのデータを先にコピペして、その下にSheet Bのデータもコピペしていく というやり方ですよね?

その通りなんですけどなぜコピーされないのかさっぱりわかりません。あとSheet Bのデータがコピーされなかったこと以外に問題がないようなのでやっぱ現在使っているブックに問題があるのかも。baooさんの方法(シート名の確認)を試してみてください。

回答
投稿日時: 17/11/29 14:23:00
投稿者: mattuwan44

あああ、セル範囲が違うのですね。

Public Sub Copy_Paste5()
    Dim shsOld As Sheets
    Dim wsNew As Worksheet
    Dim rngFirst As Range


    With ThisWorkbook.Worksheets
        'コピー元定義
        Set shsOld = .Item(Array("Sheet A", "Sheet B"))
        'コピー先定義
        Set wsNew = .Add(after:=.Item(.Count))
    End With

    'Sheet Aの操作
    With shsOld(1).UsedRange
        Set rngFirst = Intersect(.Cells, .Offset(1), .Range("C:R"))
        '操作対象のシートのC:Rをコピーし、新しいシートへ貼付
        rngFirst.Copy Destination:=wsNew.Range("A1")
    End With
    'Sheet Bの操作
    With shsOld(2).UsedRange
        Intersect(.Cells, .Offset(1), .Range("B:S")).Copy _
                Destination:=wsNew.Range("A1").Offset(rngFirst.Rows.Count)
    End With
End Sub

 
最初に提示されたコードに引きずられ過ぎてますねぇ。。。
コピペするのはあくまでも「セル範囲」だから、
変数をセル範囲で用意した方がコードがすっきりすると思います。
 
Public Sub Copy_Paste6()
    Dim rngFrom1 As Range
    Dim rngFrom2 As Range
    Dim rngTo As Range
    
    '1つ目のコピー元のセル範囲取得
    With Worksheets("Sheet A").UsedRange
        Set rngFrom1 = Intersect(.Cells, .Offset(1), .Range("C:R"))
    End With
    '2つ目のコピー元のセル範囲取得
    With Worksheets("Sheet B").UsedRange
        Set rngFrom2 = Intersect(.Cells, .Offset(1), .Range("B:S"))
    End With
    '貼付先のセル範囲取得
    With Worksheets
        Set rngTo = .Add(after:=.Item(.Count)).Range("A1")
    End With
    
    'コピペ
    rngFrom1.Copy Destination:=rngTo
    '貼付先セルの再取得
    Set rngTo = rngTo.Offset(rngFrom1.Rows.Count)
    'コピペ
    rngFrom2.Copy Destination:=rngTo
End Sub

回答
投稿日時: 17/11/29 16:51:22
投稿者: もこな2

私の「17/11/28 17:51:53」の投稿について
 ごめんなさい。よく読んだら普通にA1形式で「"C2"」〜「"R" & LastA」の
 セル範囲を指定してますね。RとかCとか出てきたんで勝手に脳内変換してました。
 biさん変な言いがかりを付けるような形になってしまい大変失礼しました。
 
私の「17/11/28 18:06:56」および「17/11/28 18:35:40」の投稿について
1234567890さんの「17/11/29 11:39:18」の投稿に対するレス

 上記の勘違いがあったので、A列、B列って言ってたんですがよく読んだら、
 「Sheet A」については、「17/11/28 10:47:03」の投稿でA〜AO列って仰って
 ましたね。こちらも失礼しました
 
さてコピー対象範囲を踏まえての改良版です。
ただ、最終行の取得について、「Sheet A」はA列、「Sheet B」はB列、「新シート」はA列を使ってますので、どのようなデータを処理したいかわかりませんが、A列なりB列なりが歯抜けだったら、うまくいかないですね。
その場合は、mattuwan44さんのように「UsedRange」の使用も検討されたほうがよいと思います。
なお、コピペ処理のところは、セル範囲は文字列で与えなくてもrange1とrange2に左上のセルと右下のセルを指定するってやりかたもありますよっていう意味です。あんまり使わなそうですが、機会があれば参考にしてください。

Sub sample()
    Dim WS As Worksheet

'ブックに「新シート」がないかチェック
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = "新シート" Then Exit Sub
    Next WS

'新規シートを追加して名前を「新シート」にしつつ、変数「WS」にセット
    Set WS = Worksheets.Add()
    WS.Name = "新シート"

'コピペ処理
    With ThisWorkbook.Sheets("Sheet A") 'コピー元範囲と貼付先セルを文字列で与える例
        .Range("A1:AO" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy _
            WS.Range("A2")
    End With

    With ThisWorkbook.Sheets("Sheet B") 'コピー元範囲をRangeプロパティで、貼付先セルをCellsプロパティで与える例
        .Range(.Range("B1"), .Range("S" & .Cells(.Rows.Count, 2).End(xlUp).Row)).Copy _
            WS.Cells(WS.Cells(WS.Rows.Count, 1).End(xlUp).Row + 1, 1)
    End With

'終了処理
    Set WS = Nothing

End Sub

投稿日時: 17/11/30 10:06:05
投稿者: 1234567890

mattuwan44 さんの引用:
Public Sub Copy_Paste2()
    Dim shsOld As Sheets
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim ixRow As Long
  
    With ThisWorkbook.Worksheets
        'コピー元定義
        Set shsOld = .Item(Array("Sheet A", "Sheet B"))
        'コピー先定義
        Set wsNew = .Add(after:=.Item(.Count))
    End With
    '貼付先行番号初期化
    ixRow = 1
    '繰り返す
    For Each ws In shsOld
        'シートの使用しているセル範囲に対して
        With ws.UsedRange
            '操作対象のシートのC:Rをコピーし、新しいシートへ貼付
            Intersect(.Cells, ws.Range("C:R")).Copy wsNew.Cells(ixRow, "A")
            '次の貼付先行番号を用意
            ixRow = ixRow + .Rows.Count
        End With
    Next
End Sub

 
mattuwan44さんのこちらのコードが、一番想像していたものに近いかなと思います。
でも、Sheet Bのデータはコピーされてないままでした。
(スクショがあればいいんですが、ここでは画像アップしてエビデンスをお見せできないみたいで残念です。)

回答
投稿日時: 17/11/30 14:17:08
投稿者: もこな2

あぁ、ようやく理解しました。

引用:
Sheet Aの状態としては、データが入っている箇所はA~AO列となります。
そこから下はエンドレスにデータが入っていくこと(=列は固定だが行がどんどん増えていく)を想定しています。
そのような状態のデータから、C~R列間に入っているすべてのデータを抜き取って、新しいシートにコピペします。
引用:
うーん、A列やB列だけでなく、SheetAのA-AO列・SheetBのB-S列のデータを行列ごと切り抜いて、新シートにそれらをコピペする のが要件なので、いただいたコードだと新シートにA, B列しかデータがコピペされていないです。。。SheetBの要件が明確でなくてすみません。

 
要はこういうことですね。
前提条件:
「Sheet A」シートのA〜AO列、「SheetB」シートのB〜S列にデータが入っているワークブックがある
 
マクロでやりたいこと:
 @ブックに新規シートを追加したい
 A追加したシートに「Sheet A」シートのC〜R列(の最終行まで)をコピペして
 BAの下の行に「Sheet B」シートのC〜R列(の最終行まで)をコピペしたい
 
わからないこと:
 なんとなく、貼付元のシートをWorksheetオブジェクトに入れてループしてやればできそうな気がするけど、そもそもオブジェクトが切り替わっていくようなセットのやり方がわからない。
 
これを元に考えれば、mattuwan44さんが投稿されたコードは特に問題がないように見えますし、実施に私の環境(Win7,Excel2013)でテストしてみましたが正常に動作しました。
 
とりあえず、原因を分析するために、コピーの対象となっている範囲が何になっているか、「Sheet B」由来のデータが何行目以降に出力されるのかを確認したほうがいいと思います。
ブレークポイント設定してイミディトウィンドウなりローカルウィンドウで調べればいいでしょうが、慣れていないと言うことであれば、MsgBox関数で画面に出しちゃいましょう。
たとえばこんな感じです。
 
Public Sub Copy_Paste3()
    Dim shsOld As Sheets
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim ixRow As Long

    With ThisWorkbook.Worksheets
        'コピー元定義
        Set shsOld = .Item(Array("Sheet A", "Sheet B"))

        '===原因解析セクション=============
        Dim 解析 As String
        解析 = _
            shsOld(1).Name & "のコピー範囲: " & _
                Intersect(shsOld(1).UsedRange.Cells, shsOld(1).Range("C:R")).Address & vbCrLf & _
            shsOld(2).Name & "のコピー範囲: " & _
                Intersect(shsOld(2).UsedRange.Cells, shsOld(2).Range("C:R")).Address & vbCrLf & _
            shsOld(2).Name & "由来データの開始行: " & _
                Intersect(shsOld(1).UsedRange.Cells, shsOld(1).Range("C:R")).Rows.Count + 1
        解析 = Replace(解析, "$", "")
        MsgBox (解析)
        Exit Sub
        '=========================
        'コピー先定義
        Set wsNew = .Add(after:=.Item(.Count))
    End With
    '貼付先行番号初期化
    ixRow = 1
    '繰り返す
    For Each ws In shsOld
        'シートの使用しているセル範囲に対して
        With ws.UsedRange
            '操作対象のシートのC:Rをコピーし、新しいシートへ貼付
            Intersect(.Cells, ws.Range("C:R")).Copy wsNew.Cells(ixRow, "A")
            '次の貼付先行番号を用意
            ixRow = ixRow + .Rows.Count
        End With
    Next
End Sub

ちょっと力業ですけど、原因分析はできるとおもいます。
なんとなくですけど、「Sheet A」のとんでもない行までUsedRangeとして認識されちゃってるように思うんですが・・・

回答
投稿日時: 17/11/30 15:34:35
投稿者: baoo

ちょっと条件がよくわからないですね。
Sheet AのA:AO列、Sheet BのB:S列のデータのある所をコピーしたいのですか?
それともSheet A、Sheet B共にC:R列のデータのある所をコピーしたいのですか?
 
下記では駄目でしょうか?
ご希望に合わせてコメントを外すなり追加して実行してみてください。

Public Sub Copy_Paste_Baoo()
 
    Dim rngA As Range
    Dim rngB As Range
    Dim shtNew As Worksheet
    
    With ThisWorkbook
    
        'Sheet AはA:AO列、Sheet BはB:S列をコピー?
        Set rngA = .Worksheets("Sheet A").UsedRange.Columns("A:AO")
        Set rngB = .Worksheets("Sheet B").UsedRange.Columns("B:S")
        
        'Sheet A、Sheet B共にC:R列をコピー?
        'Set rngA = .Worksheets("Sheet A").UsedRange.Columns("C:R")
        'Set rngB = .Worksheets("Sheet B").UsedRange.Columns("C:R")
        
        Set shtNew = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        shtNew.Name = "新シート"
        
        rngA.Copy shtNew.Cells(1, 1)
        rngB.Copy shtNew.Cells(rngA.Rows.Count + 1, 1)
        
    End With
 
End Sub

投稿日時: 17/11/30 15:57:24
投稿者: 1234567890

baoo さんの引用:
1234567890 さんの引用:
実行時エラーのデバッグを押しましたが、黄色くなったのはこの文です。
Sheets("Sheet A").Range("C2:R" & LastA).Copy Sheets("新シート").Range("A2")
&nbsp;
シート名が違う、とは考えづらいです。

こういう場合の考え方として、イミディエイトウィンドウに
?Sheets("Sheet A").Name
と入力してEnterキーを押す。
エラーが発生するなら、そんな名前のシートは存在しません。
そして
?Sheets("新シート").Name
もやっておきましょう。
 
次に同じようにイミディエイトウィンドウに
?LastA
と入力してみる。
0だったらだめですよね。
 
あるいは、その場で
Sub DebugBookSheetName()
    
    Dim wb As Workbook
    Dim sht As Worksheet
    
    For Each wb In Workbooks
        Debug.Print wb.Name
        For Each sht In wb.Worksheets
            Debug.Print " " & sht.Name
        Next
    Next
    
End Sub
を実行してみる。
そしてブック名、シート名が正しいかを確認する。
なんだったらイミディエイトウィンドウに表示されたシート名をコピーして
コピペで実際のシート名に対して名前の変更を実施して貼り付けるとか。
(上記コードではブック名との区別の為にシート名の前にスペースを追加しているので注意)
初心者の方は見た目で同じだと判断するかもしれませんが、
書き慣れた人ならそういう判断はしません。
 
どう見てもシート名が"AAAAAA"にしか見えなくても
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AAA" & vbCrLf & "AAA"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AAA" & vbCr & "AAA"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AAA" & vbLf & "AAA"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "AA" & vbCrLf & "AAAA"
として作成されていれば全部別物です。
 
 
 
 

 
 
baooさん
アドバイスありがとうございます。
イミディエイトウィンドウ、あまり使ったことがないですがこれを機に使うようにします。
でも当分はMsgBoxに頼りそうですが・・・。
 
バグエラーが出たときはイミディエイトウィンドウで確かめると早そうですね。

回答
投稿日時: 17/11/30 16:36:59
投稿者: mattuwan44

>mattuwan44さんのこちらのコードが、一番想像していたものに近いかなと思います。
>でも、Sheet Bのデータはコピーされてないままでした。
ちなみにシート上にコピー対象でない行にも数式を事前に入れてますか?
また、罫線等も余分に引いてないですか?
あるいは、何もないと思っているがとつもなく下の方にデータが入力されてたり、
列丸ごとセルに色を付けてたりしてないですか?
 
マクロ実行後、
 
Ctrl + ↓
 
で、下に行ってみてもデータがないですか?
 
 
>With ws.UsedRange
→With ws.Range("A1").currentregion
に変更するとどうなりますか?
 
 
 
 

回答
投稿日時: 17/11/30 16:42:53
投稿者: mattuwan44

他のコードはさておき、↓のコードを試してみてもらえます?
で、メッセージボックスにどのようなアドレスが表示されるか教えてください。
 
Public Sub Copy_Paste6()
    Dim rngFrom1 As Range
    Dim rngFrom2 As Range
    Dim rngTo As Range
 
    '1つ目のコピー元のセル範囲取得
    With Worksheets("Sheet A").UsedRange
        Set rngFrom1 = Intersect(.Cells, .Offset(1), .Range("C:R"))
    End With
    '2つ目のコピー元のセル範囲取得
    With Worksheets("Sheet B").UsedRange
        Set rngFrom2 = Intersect(.Cells, .Offset(1), .Range("B:S"))
    End With
    '貼付先のセル範囲取得
    With Worksheets
        Set rngTo = .Add(after:=.Item(.Count)).Range("A1")
    End With
 
    If MsgBox(rngFrom1.Address(, , , True) & "の範囲をコピーします。", vbYesNo) = vbYes Then
        'コピペ
        rngFrom1.Copy Destination:=rngTo
        'コピペ
        rngFrom2.Copy Destination:=rngTo.Offset(rngFrom1.Rows.Count)
    End If
End Sub

投稿日時: 17/12/01 15:28:56
投稿者: 1234567890

mattuwan44 さんの引用:
>mattuwan44さんのこちらのコードが、一番想像していたものに近いかなと思います。
>でも、Sheet Bのデータはコピーされてないままでした。
ちなみにシート上にコピー対象でない行にも数式を事前に入れてますか?
→数式は入れていないです。
また、罫線等も余分に引いてないですか?
→罫線も余分に引いてないです。
あるいは、何もないと思っているがとつもなく下の方にデータが入力されてたり、
列丸ごとセルに色を付けてたりしてないですか?
→・・・これでした。
 
マクロ実行後、
 
Ctrl + ↓
 
で、下に行ってみてもデータがないですか?
 
 
>With ws.UsedRange
→With ws.Range("A1").currentregion
に変更するとどうなりますか?
 
 
 
 

 
mattuwan44さん
 
なんと!マクロ実行後にControlボタンと↓ボタンを押したら確かにずーっと下のほうにもう一つのシートのデータがありました。失礼しました。
Sheet Aのデータのすぐ真下にSheet Bのデータもコピペされるもんだ、とばかり思っていました。そうはいかないのですね。。。
 
 

投稿日時: 17/12/01 15:32:22
投稿者: 1234567890

baoo さんの引用:
ちょっと条件がよくわからないですね。
Sheet AのA:AO列、Sheet BのB:S列のデータのある所をコピーしたいのですか?
それともSheet A、Sheet B共にC:R列のデータのある所をコピーしたいのですか?
 
下記では駄目でしょうか?
ご希望に合わせてコメントを外すなり追加して実行してみてください。
Public Sub Copy_Paste_Baoo()
 
    Dim rngA As Range
    Dim rngB As Range
    Dim shtNew As Worksheet
    
    With ThisWorkbook
    
        'Sheet AはA:AO列、Sheet BはB:S列をコピー?
        Set rngA = .Worksheets("Sheet A").UsedRange.Columns("A:AO")
        Set rngB = .Worksheets("Sheet B").UsedRange.Columns("B:S")
        
        'Sheet A、Sheet B共にC:R列をコピー?
        'Set rngA = .Worksheets("Sheet A").UsedRange.Columns("C:R")
        'Set rngB = .Worksheets("Sheet B").UsedRange.Columns("C:R")
        
        Set shtNew = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        shtNew.Name = "新シート"
        
        rngA.Copy shtNew.Cells(1, 1)
        rngB.Copy shtNew.Cells(rngA.Rows.Count + 1, 1)
        
    End With
 
End Sub


 
baooさん
条件は「Sheet AのA:AO列、Sheet BのB:S列のデータのある所をコピーしたい」になります。
baooさんのコードも動かしてみます。
たぶんこれでもいけそうな気がします。

投稿日時: 17/12/01 16:11:54
投稿者: 1234567890

mattuwan44 さんの引用:
他のコードはさておき、↓のコードを試してみてもらえます?
で、メッセージボックスにどのようなアドレスが表示されるか教えてください。
 
Public Sub Copy_Paste6()
    Dim rngFrom1 As Range
    Dim rngFrom2 As Range
    Dim rngTo As Range
 
    '1つ目のコピー元のセル範囲取得
    With Worksheets("Sheet A").UsedRange
        Set rngFrom1 = Intersect(.Cells, .Offset(1), .Range("C:R"))
    End With
    '2つ目のコピー元のセル範囲取得
    With Worksheets("Sheet B").UsedRange
        Set rngFrom2 = Intersect(.Cells, .Offset(1), .Range("B:S"))
    End With
    '貼付先のセル範囲取得
    With Worksheets
        Set rngTo = .Add(after:=.Item(.Count)).Range("A1")
    End With
 
    If MsgBox(rngFrom1.Address(, , , True) & "の範囲をコピーします。", vbYesNo) = vbYes Then
        'コピペ
        rngFrom1.Copy Destination:=rngTo
        'コピペ
        rngFrom2.Copy Destination:=rngTo.Offset(rngFrom1.Rows.Count)
    End If
End Sub

 
コード、試してみました。エラーもバグもなく、両方のシートの該当範囲がコピペされました。
メッセージボックスには「'[Test Tool.xlsm]SheetA'!$C$2:$R$174の範囲をコピーします。」と出ました。

回答
投稿日時: 17/12/01 16:14:52
投稿者: もこな2

1234567890 さんの引用:
なんと!マクロ実行後にControlボタンと↓ボタンを押したら確かにずーっと下のほうにもう一つのシートのデータがありました。失礼しました。
Sheet Aのデータのすぐ真下にSheet Bのデータもコピペされるもんだ、とばかり思っていました。そうはいかないのですね。。。
やっぱり・・・という感じですね
このスレッドのコメントを拝見していると、回答のあったコードをそのまま、貼り付けて実行してみて結果を報告しているだけのように見えます。
 
この手の掲示板で質問されているということは、学習する気持ちはお持ちだとおもうので、わからない関数やメソッドが出てきたら、とりあえず調べてみる。コードもそのまま実行するのではなく、ブレークポイントを設定したり、ステップイン実行してどこが思うように動いていないのかを分析する。等のデバッグスキルの向上もあわせて取り組まれることをオススメします。
 
最後に以下が気になります。
1234567890 さんの引用:
baooさん
条件は「Sheet AのA:AO列、Sheet BのB:S列のデータのある所をコピーしたい」になります。
baooさんのコードも動かしてみます。
たぶんこれでもいけそうな気がします。

「Sheet A」のとんでもなく下の方にあるものは要らないデータで削除しても差し支えないのであれば、削除してやれば、今のままのコードでも正常に動作というかご希望の動作をするようにおもいますし、逆に言えば「Sheet A」のとんでもなく下の方にあるデータを何とかするか、アプローチ方法を変えないと「Worksheets("Sheet A").UsedRange.Columns(C:R)」が返してくるのはとんでもなく下のまでを含んだセル範囲なので、問題解決しないとおもいます。(これでいけそうっていうのがに対しての話であればいいんですが、その場合、貼り付けてできあがったデータは列数が違う表がくっついたものになるけどいいんでしょうか・・・)

回答
投稿日時: 17/12/03 10:18:14
投稿者: mattuwan44

引用:
コード、試してみました。エラーもバグもなく、両方のシートの該当範囲がコピペされました。
メッセージボックスには「'[Test Tool.xlsm]SheetA'!$C$2:$R$174の範囲をコピーします。」と出ました。

つまり、コピーしたいセル範囲が正しく取得できたということですよね?
シート上の状況により使える命令あるいは方法、考え方など、
その状況により、いろいろな言い表し方があります。
 
回答側では、あなたのパソコンは見えません。
なので、シート上の状態を正しく伝えていただかないと、
こちら側からは期待した動作をさせることができない場合があります。
ご自分でそういうことを調べて、把握して、対応できるようにならないといけません。
そのために、いろいろたくさんやり取りすることはとても有意義だと思います。
 
まずは、こんなにたくさんやり取りしなくても状況を相手にちゃんと伝えられるようになりましょう。
 
次に、1行1行、1単語1単語の意味をちゃんと理解しましょう。
きっと、そういう努力をされている方だと思うので、すぐにVBAを使えるようになると思いますよ^^
 
参考URL>>
http://www.ken3.org/vba/excel-help.html

トピックに返信