![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
win7 Excel2007 でマクロ作成中の初心者です。
シート数の変動する複数シートの特定範囲を一枚のシートに右列方向に、値を貼り付けたいです。
自動記録でコード作成しましたが、もっと簡素化して軽くしたいです。
シートに対するループ等の作成ができません。どうかご指導お願いします。
Sub 勤怠最終データ作成()
Worksheets(1).Select '1番左のシートを選択
ActiveSheet.Unprotect
Range("B29:BM60").Select '複写範囲はすべて同じ
Selection.Copy
Sheets("総括").Select '値の貼り付けシートはすべて同じ
Range("A2").Select '値の貼り付け先
Selection.PasteSpecial Paste:=xlPasteValues
’--------------------------------------
Worksheets(2).Select '2枚目のシートを複写
ActiveSheet.Unprotect
Range("B29:BM60").Select
Selection.Copy
Sheets("総括").Select
最終セルの選択 '値の貼り付け先
Selection.PasteSpecial Paste:=xlPasteValues
’--------------------------------------
Worksheets(3).Select '3枚目のシートを複写
ActiveSheet.Unprotect
Range("B29:BM60").Select
Selection.Copy
Sheets("総括").Select
最終セルの選択
Selection.PasteSpecial Paste:=xlPasteValues
’--------------------------------------
Worksheets(4).Select '4枚目のシートを複写
ActiveSheet.Unprotect
Range("B29:BM60").Select
Selection.Copy
Sheets("総括").Select
最終セルの選択
Selection.PasteSpecial Paste:=xlPasteValues
以下省略
End Sub
No.3ベストアンサー
- 回答日時:
No.1・2です!
続けておじゃまします。
よく確認せずに投稿してごめんなさい。
「値」の貼り付けですね!
セルの結合は無視されてしまいますが・・・
Sub test()
Dim k As Long
Dim ws As Worksheet
Set ws = Worksheets("総括")
Application.DisplayAlerts = False
On Error Resume Next
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> "総括" Then
Range(Worksheets(k).Cells(29, "B"), Worksheets(k).Cells(60, "BM")).Copy
ws.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next k
Range(ws.Cells(2, 1), ws.Cells(60, 1)).Delete (xlToLeft)
ws.Cells(2, 1).Select
End Sub
※ 今回は「総括」Sheetがどこにあっても対応できるようにしてみました。
こんなんで参考になりますかね?m(_ _)m
私の思っている通りのことが実現できました。本当に感謝感激です。そのコードを見たとき半分ほどしか理解できず、まるでマジックショーを見ているようです。大変おせわになりました。今後共よろしくお願いします。
No.2
- 回答日時:
No.1です!
補足の
>上のせる範囲には横方向のセルの結合がしてあります。
とありますがコピー元のSheetが結合されているのか?それとも「総括」Sheetが結合されているのか?
判らないのですが、
場合によっては結合を解除してやる必要があるかもしれません。
とりあえずコードを↓に変更してみてください。
Sub test()
Dim k As Long
Dim ws As Worksheet
Set ws = Worksheets("総括")
Application.DisplayAlerts = False
On Error Resume Next
For k = 2 To Worksheets.Count
Range(Worksheets(k).Cells(29, "B"), Worksheets(k).Cells(60, "BM")).Copy Destination:= _
ws.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
Next k
ws.Range(Cells(2, 1), Cells(60, 1)).Delete (xlToLeft)
End Sub
エラーを無視するようにしてみましたが、これでもダメなら
別方法(セルの結合解除等)を考える必要があるかもしれません。
その場合は具体的な表のレイアウトが判らないと
的確なアドバイスができないと思います。
この程度でごめんなさいね。m(_ _)m
この回答への補足
教えていただいたコードを実行したとろこ、すべての貼り付けになっていまして、セルに入っている関数がそのままなので、値の貼り付けでないので、このセルの値のデータを利用して再加工することができません。
各シートのコピー元が横結合しています。コピー先は一切結合していません。どうぞよろしくおねがいします。
No.1
- 回答日時:
こんにちは!
「総括」SheetはSheet見出し上で一番左側にあるとします。
標準モジュールにコピー&ペーストしてマクロを実行してみてください。
Sub test()
Dim k As Long
Dim ws As Worksheet
Set ws = Worksheets("総括")
For k = 2 To Worksheets.Count
Range(Worksheets(k).Cells(29, "B"), Worksheets(k).Cells(60, "BM")).Copy Destination:= _
ws.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
Next k
ws.Range(Cells(2, 1), Cells(60, 1)).Delete (xlToLeft)
End Sub
※ 各SheetのBM2セルには何らかのデータが入っているとします。
(そうでないと、最終列の取得が滅茶苦茶になってしまいます)
こんな感じでよろしいのでしょうか?m(_ _)m
この回答への補足
素早いご回答ありがとうございます。私の自動記録のマクロで作動したのですが、ご指摘のコードを実行したところ、「コピー領域と貼り付け領域の形が・・・で貼り付けできません。」のエラーがでます。前もってお知らせすべきでした。上のせる範囲には横方向のセルの結合がしてあります。まさかのショックです。
どうしたらよろしいでしょうか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) データのある範囲を選択するVBAについて 2 2022/09/03 00:20
- Excel(エクセル) エクセル VBAでシートのコピーを作りたい 1 2023/05/18 07:42
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Excel(エクセル) ②Excel 簡単にシートコピーしたら前日の残高と日付を変更させたい→マクロの記録でエラーが出ます 8 2022/07/16 20:40
- Visual Basic(VBA) マクロで最終行を取得してコピーしたい 3 2022/04/06 19:07
- Excel(エクセル) エクセルのマクロについて教えてください。 3 2023/02/07 14:47
- Visual Basic(VBA) 動きっぱなしです。止め方とプロシージャの間違いを教えて下さい! 5 2022/08/15 23:08
- Excel(エクセル) エクセルで最下行にデータを追加するVBA 6 2023/05/09 09:30
- Visual Basic(VBA) 複数シート一括作成後に、特定範囲の数式は値で貼り付けしたい 3 2022/10/07 11:18
- Excel(エクセル) ExcelVBAについて。 2 2022/12/10 20:08
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
VBA別シートの最終行の次行へ転...
-
Count Ifのセルの範囲指定に変...
-
Excel2013で切り取り禁止
-
VBA 空白行に転記する
-
Changeイベントで複数セルへの...
-
VBA 別ブックからの転記の高速...
-
VBA シリアル値から月日への変換
-
【Excel VBA】自動メール送信の...
-
EXCELのSheet番号って変更でき...
-
【VBA】データを各シートに自動...
-
Unionでの他のシートの参照につ...
-
マクロ実行後に別シートの残像...
-
複数シートの複数列に入力され...
-
VBAで変数の数/変数名を動的に...
-
【VBA】特定の条件でセルをコピー
-
Excelのシート別でのセルのリン...
-
VBAのグラフに違うシートの...
-
アクセスからエクセルへ出力時...
-
ExcelのVBマクロを、バックグラ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
マクロ実行後に別シートの残像...
-
VBA別シートの最終行の次行へ転...
-
Count Ifのセルの範囲指定に変...
-
Changeイベントで複数セルへの...
-
VBAで変数の数/変数名を動的に...
-
VBA 別ブックからの転記の高速...
-
VBA 実行時エラー1004 rangeメ...
-
【VBA】特定の条件でセルをコピー
-
楽天RSSからエクセルVBAを使用...
-
Unionでの他のシートの参照につ...
-
ExcelのVBマクロを、バックグラ...
-
複数シートの複数列に入力され...
-
100万件越えCSVから条件を満た...
-
VBA Userformで一部別シートに...
-
Excel VBA オートフィルターで...
-
Excel2013で切り取り禁止
-
VBAでEXCELから固定長...
おすすめ情報