こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel2007 VBAでブックのコピーについて

VBAでブックのコピー仕方が分からないので教えて下さい

やりたいことはBook1とBook2のシートデータを統合した物をBook3に書き出したいです

具体的には以下になります

Book1

シート名

パターン1 パターン5 A-1 B-2 B-3 B-4 C-1 C-3 C-5 C-7

Book2

パターン2 パターン3 パターン4 パターン6 D-5 D-6 D-7 D-8 E-9 E-10 F-1 F-5

これをパターン1を先頭にアルファベット順に整列してBook3に書き出す作業をしたいです

求めている結果

Book3

パターン1 パターン2 パターン3 パターン4 パターン5 A-1 B-2 B-3 B-4 C-1 C-3 C-5 C-7 D-5 D-6 D-7 D-8 E-9 E-10 F-1 F-5

Book1とBook2のシート名に関しては重複するシート名はないが並び順がばらばらなので

Book3に合体させたときにパターン1を先頭にアルファベットのA-1から順番に整列させたいです

どのようにマクロを記述したらいいのか分からず困っているのでよろしくお願いします

シートの中には画像やオートシェイプなども入っています

投稿日時 - 2012-04-15 10:35:52

QNo.7422075

すぐに回答ほしいです

質問者が選んだベストアンサー

No.2・3です。

投稿後に思ったのですが・・・
補足の2番目
>また、ID名に132と76などの数字が入っていると132の方が前にきてしまいます

は「ID名」とはSheet名のコトでその並びが希望通りにならない!ということでしょうか?
もしそうであれば、
前回のコードはとりあえずSheet名を新しいSheetに列挙し、並び替えを行っていますので、
数値の後に文字列があればそうなります。

その回避方法としては数値の桁数を揃えるといった工夫が必要になると思います。
132〇〇〇 や076△△△
といった具合です。

これも外していたらごめんなさいね。m(_ _)m

投稿日時 - 2012-04-17 11:24:54

お礼

ありがとうございます
今度作るときはそうします
大変助かりました

投稿日時 - 2012-04-20 23:21:55

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.4

はて?
>オートシェイプがずれる

回答1のマクロと、回答2のマクロの、本当に間違いなく両方のマクロを試して、両方とも同じくズレたのですか?



ま、いずれにしても。
出自の異なる(とは、簡単に言えばたとえば「別のパソコンのエクセルで作成した」といった状況のことです)複数のブックから、無理矢理今回のように一つのブックに束ねようとすると、そういったことが起きる可能性があります。
マクロの問題ではなく「ブック自体が悪い」ので、今の状況から「そうならないようにする」方法はありません。

ここから修繕するのは事実上「まっさらブックから全部のデータを作り直す」のと同じことなので、今はとりあえず「統合」だけ果たし、ずれたモノは許容できる範囲で修正してご利用になった方が正解です。

投稿日時 - 2012-04-16 23:21:15

補足

両方とも試して、両方ともずれていました
しかも全部ではなく幾つかなんです

出自が異なるとはなんですが

一つは私がもう一つは別の人がマックで作ったものです

私が作ったものとマックで作ったものの
どちらも全部ではなく幾つかだけずれてしまいます。

keithinさんのおっしゃるとおり

今はとりあえず「統合」だけ果たし、ずれたモノは許容できる範囲で修正して使ってみます
本当にありがとうございました
大変助かりました

投稿日時 - 2012-04-17 12:06:37

ANo.3

No.2です!
補足の件について・・・
(1)の
>シートに入っているオートシェイプが全部ではなく、左に幾つかずれてしまいます
に関しては元Sheetの「オートシェイプの書式設定」の「オブジェクトの位置関係」で
「セルに合わせて移動やサイズを変更しない」にしてみてはどうでしょうか?
それを一つ一つ手作業でやるもの大変だと思いますので、

無理矢理とってつけたようなコードになりますが、
前回のコード内の
>For k = 1 To myArray(j).Worksheets.Count
>str = myArray(j).Worksheets(k).Name
の2行の間に
>Dim S As Shape
>For Each S In myArray(j).Worksheets(k).Shapes
>S.Placement = xlFreeFloating
>Next S
の3行を挿入してみてください。

これで元Sheetのオートシェイプは「セルに合わせて・・・変更しない」になると思います。

次にID番号の順番が変わってしまう!という件ですが、
考えられる原因といえばSheet順が変わったことにより表示順も変わってしまった。
というコトです。

元データがどのような状態なのか把握できないので、原因がはっきり判らないのですが、
関数等で別Sheetを参照してIDを表示されていますか?
もしそうであっても通常はSheet名が関数に入っているので問題はないと思います。

もし、マクロでSheet名ではなくインデックス番号でSheetを指定し、IDを表示させている場合は
そのようなことも考えられますが、
それが直接の原因かどうかは判りません。

この程度であまりお役に立てないのですが、ごめんなさいね。m(_ _)m

投稿日時 - 2012-04-16 23:10:26

お礼

いえいえ、大変助かります
嬉しいです

投稿日時 - 2012-04-20 23:22:28

ANo.2

こんばんは!
一例です。
まっさらなBookの標準モジュールにコピー&ペーストしてマクロを実行してみてください。

Sub test()
Dim i, j, k As Long
Dim wb1, wb2 As Workbook
Dim ws As Worksheet
Dim str As String
Dim myArray As Variant
Set ws = Worksheets(1)
Set wb1 = Workbooks("Book1.xlsx")
Set wb2 = Workbooks("Book2.xlsx")
myArray = Array(wb1, wb2)
Worksheets.Add before:=Worksheets(1)
For j = 0 To 1
For k = 1 To myArray(j).Worksheets.Count
str = myArray(j).Worksheets(k).Name
If str Like "パターン*" Then
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
1 & myArray(j).Worksheets(k).Name
Else
ws.Cells(Rows.Count, 1).End(xlUp).Offset(1) = _
myArray(j).Worksheets(k).Name
End If
Next k
Next j
ws.Columns(1).Sort key1:=ws.Cells(1, 1), order1:=xlAscending
For i = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(i, 1) Like "1*" Then
ws.Cells(i, 1) = Mid(ws.Cells(i, 1), 2, Len(ws.Cells(i, 1)))
End If
Next i
For k = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ws.Cells(k, 1)
Next k
For j = 0 To 1
For i = 1 To Worksheets.Count
For k = 1 To myArray(j).Worksheets.Count
If Worksheets(i).Name = myArray(j).Worksheets(k).Name Then
myArray(j).Worksheets(k).Cells.Copy Destination:= _
Worksheets(i).Cells(1, 1)
End If
Next k
Next i
Next j
For k = Worksheets.Count To 1 Step -1
Application.DisplayAlerts = False
If Worksheets(k).Name Like "Sheet*" Then
Worksheets(k).Delete
End If
Application.DisplayAlerts = True
Next k
End Sub

※ Book1・Book2は開いたうえでマクロを実行してください。
参考になりますかね?m(_ _)m

投稿日時 - 2012-04-15 18:13:56

補足

ありがとうございます
やってみたのですが、シートに入っているオートシェイプが全部ではなく、左に幾つかずれてしまいます

また、ID名に132と76などの数字が入っていると132の方が前にきてしまいます。

上記二点の修正の仕方も教えて頂けないでしょうか?
よろしくお願い致します。

投稿日時 - 2012-04-16 21:01:45

ANo.1

丁寧に調査して並べ替えるだけの作業です。
マクロのご質問ですから,最低限マクロの使い方はご存じですね。



準備:
(いわずもがなですが,ファイル名とか拡張子とかは適切に作成しなければなりません)
Book1.xlsxとBook2.xlsxがあるとして
それぞれのブックを開いておいて
加えてbook3.xlsmを用意,book3.xlsmに標準モジュールを用意して下記を記入し実行する。

sub macro1()
 dim w(1) as variant
 dim s0 as worksheet
 dim s as worksheet
 dim h as range
 dim i as integer

’準備する
 set w(0) = workbooks("Book1.xlsx")
 set w(1) = workbooks("Book2.xlsx")
 thisworkbook.activate
 set s0 = thisworkbook.worksheets.add(before:=thisworkbook.worksheets(1))

’調査する
 s0.range("A1:C1") = array("book name", "sheet name", "seg1-seg2")
 for i = 0 to 1
 for each s in w(i).worksheets
  with s0.range("A65536").end(xlup).offset(1)
   .value = w(i).name
   .offset(0, 1).value = s.name
   .offset(0, 2).value = strconv(iif(s.name like "パタ?ン*",replace(s.name,left(s.name, 4)," パターン-"),s.name), vbnarrow)
  end with
 next
 next i

’並べ替える
 range("C:C").texttocolumns _
  destination:=range("C1"), _
  datatype:=xldelimited, _
  otherchar:="-"
 range("A:D").sort _
  key1:=range("C1"), order1:=xlascending, _
  key2:=range("D1"), order2:=xlascending, _
  header:=xlyes

’収集する
 for each h in range("A2:A" & range("A65536").end(xlup).row)
 workbooks(h.value).worksheets(h.offset(0, 1).value).copy after:=thisworkbook.worksheets(thisworkbook.worksheets.count)
 next

’片付ける
 application.displayalerts = false
 for each s in thisworkbook.worksheets
  if s.name like "Sheet*" then s.delete
 next
 application.displayalerts = true
 thisworkbook.worksheets(1).select

end sub

投稿日時 - 2012-04-15 14:30:54

補足

ありがとうございます
統合はできたのですが
シートに入っているオートシェイプが
統合する前のファイルと比べると
全シートではないのですが
幾つかそれもかなりの数(半分くらい)
左に少しずれてしまうのですが
これはずれないで統合することはできないのでしょうか?

拡張子がxlsxではなくxlsなのも関係しているのでしょうか?

投稿日時 - 2012-04-16 20:58:06

あなたにオススメの質問