[EXCEL] シートを統合するマクロ
- 全てのシートを「ALL」という名前のシートに統合するマクロがあります。
- しかし、「ALL」というシートの一番上の一行が空いてしまいます。
- 1行目から使用するためにはどこをどう書き換えれば良いでしょうか？
- ベストアンサー
[EXCEL] シートを統合するマクロ
下記は全てのシートを"ALL"という名前のシートに統合するマクロのようですが、"ALL"というシートの一番上 一行が 空きになってしまいます。1行目から使用したいのですが、 どこをどう書き換えれば良いのでしょうか？ Sub copy() s0 = ActiveSheet.Name Sheets.Add.Name = "ALL" s1 = ActiveSheet.Name For Each mySH In Sheets If mySH.Name <> s0 Then If mySH.Name <> s1 Then myE = Range("A65536").End(xlUp).Row + 1 myE2 = mySH.Range("A65536").End(xlUp).Row mySH.Range("1:" & myE2).copy Range(myE & ":" & myE) End If End If Next End Sub
- yama0520
- お礼率41% (7/17)
- Windows XP
- 回答数1
- ありがとう数0
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
２回続くIF文の次の行 myE = Range("A65536").End(xlUp).Row + 1 の + 1 をとりのぞく、でよさそうに思いますが、試験してません。
関連するQ&A
- excel2000マクロについて
下記の様なマクロを書いていますが、別のマクロの記述の仕方で短縮に書くことはできないでしょうか。 Sub 承認捺印() Sheets("実行").Select If Range("E13").Value = "申請者" Then Sheets("ログイン").Select If Range("F11").Value = "a8012661" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 15").Copy Call 申請者捺印 End If If Range("F11").Value = "a6601456" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 16").Copy Call 申請者捺印 End If If Range("F11").Value = "t9907028" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 17").Copy Call 申請者捺印 End If If Range("F11").Value = "a7545410" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 18").Copy Call 申請者捺印 End If If Range("F11").Value = "t9806047" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 19").Copy Call 申請者捺印 End If If Range("F11").Value = "t0206030" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 20").Copy Call 申請者捺印 End If end if end sub Sub 申請者捺印() Sheets("報告票").Select Range("m3").Select ActiveSheet.Paste Range("a1").Select End Sub
- ベストアンサー
- オフィス系ソフト
- 【Excel VBA】ワークシートの表示(続き)
すみません。 追記が出来なかったため、コードの続きをこちらに記載します。 For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか？", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Exit For ElseIf Anser = vbNo Then Exit For End If End If Next If Flag = O Then MsgBox ("新しいワークシートを作成出来ません。") End If If actsht = tmp(i) Then If Sheets(元データ).Visible = False Then Sheets(元データ).Visible = True End If End If End Sub
- 締切済み
- 情報工学
- 既存のマクロを他のエクセルファイルで使用したい
下記のマクロを使おうと思うと、 このマクロがついたファイルを開いて 他のエクセルファイルを開くのですが使えません。 使おうとするとマクロのついたファイルに戻ってしまいます。 Sub test01() Dim ws As Worksheet For Each ws In Worksheets If ws.Name = "統合シート" Then Else ws.Activate d = ws.Range("A65535").End(xlUp).Row ws.Range(Cells(1, "A"), Cells(d, "C")).Copy Sheets("統合シート").Activate Sheets("統合シート").Range("A65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste End If Next End Sub どこを変えればよいのでしょうか。 教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- ブックの統合について
Sub 集計() Application.ScreenUpdating = False fldPath = ThisWorkbook.Path & "\" fname = Dir(fldPath & "*.xls") Do Until fname = Empty If fname <> ThisWorkbook.Name Then Workbooks.Open fldPath & fname mx = Application.WorksheetFunction.Max(Sheets("1日").Columns(1)) lr = Sheets("1日").Range("B65536").End(xlUp).Row FR = ThisWorkbook.Sheets("1日").Range("B65536").End(xlUp).Row + 1 Sheets("1日").Rows("6:" & lr).Copy Application.DisplayAlerts = False ActiveWorkbook.Close (False) Application.DisplayAlerts = True ThisWorkbook.Sheets("1日").Cells(FR, 1).Select ActiveSheet.Paste Application.CutCopyMode = False End If fname = Dir Loop Application.ScreenUpdating = True End Sub 上記のようにマクロを組みましたが、集計したいシートがたくさんある為 シートごとにマクロを組みなおさなければなりません。 そこで、 集計するシートと集計されるシートのシート名が一緒の時、 わざわざsheets("1日")と書き直さなくても "Activesheetと同じシート名"のようなマクロの組み方は出来るのでしょうか。
- ベストアンサー
- その他(データベース)
- エクセル マクロ エラー
Sub 保存() Dim MySheetName As Variant MySheetName = InputBox("シート名を入力してください") If MySheetName = "" Then Exit Sub Sheets("1").Copy After:=Sheets(Worksheets.Count) ActiveSheet.Name = MySheetName Sheets("原本").Range("A1:K73").Copy Sheets("1原本").Range("A1") End Sub シートにグラフを乗せたらエラーが出たのですが 解除できないでしょうか？
- ベストアンサー
- Excel（エクセル）
- 【Excel VBA】フォームボタンの操作
IF文の中でフォームボタンを自動でクリックする処理を追記したく、 以下のコードで実行しましたが、エラーとなりました。 IF文のSubプロシージャが閉まっていないと弾かれたのですが、 どう修正すれば正常に機能しますでしょうか？ ここから↓ actsht = ActiveSheet.Name For i = 1 To 12 If actsht = tmp(i) Then Flag = 1 Anser = MsgBox("翌月分シートを作成しますか？", vbYesNo + vbDefaultButton1, "確認") If Anser = vbYes Then ActiveSheet.Copy After:=ActiveSheet ActiveSheet.Name = tmp(i + 1) Sheets(actsht).Tab.ColorIndex = 2 Sheets(actsht).Range("B3").Value = Sheets("Sheet2").Range("A1").Value Sheets(actsht).Range("B4").Value = Sheets("Sheet2").Range("A2").Value ActiveSheet.Range("A2").Select Private Sub clear_Click() '※ End Sub '※ Exit For ElseIf Anser = vbNo Then Exit For End If End If Next
- 締切済み
- 情報工学
- マクロで困ってます！
マクロでセル検索かけたらそのセルに設定していたハイパーリンクが外れてしまいます。 どうすればいいでしょうか・・？お力を貸してください！ バージョンは2007です！ コードは下記になります！ 同一ブック内の「データ」というシートにあるものを「検索更新」というシートで検索をかけるというものです。 宜しくお願いします！！ Sub 検索2() myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 If myLAST < 5 Then myLAST = 5 Range("A5:F" & myLAST).ClearContents Set myC = Sheets(1).Columns(3) _ .Find(What:=Range("E2").Value, _ LookIn:=xlValues, LookAt:=xlPart) ' If myC Is Nothing Then Exit Sub myCa = myC.Address Do myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 Range("A" & myLAST) = myC.Row Range("B" & myLAST) = myC.Offset(0, -1) Range("C" & myLAST) = myC.Offset(0, 0) Range("D" & myLAST) = myC.Offset(0, 1) Range("E" & myLAST) = myC.Offset(0, 2) Range("F" & myLAST) = myC.Offset(0, 3) Set myC = Sheets(1).Columns(3).FindNext(myC) If myC Is Nothing _ Or myCa = myC.Address Then Exit Do Loop Set myC = Nothing End Sub Sub 更新() myLAST = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row If myLAST < 5 Then myLAST = 5 For Each myC In Range("A5:A" & myLAST) If myC.Value = "" Then Exit Sub With Sheets(1) .Range("B" & myC.Value) = myC.Offset(0, 1) .Range("C" & myC.Value) = myC.Offset(0, 2) .Range("D" & myC.Value) = myC.Offset(0, 3) .Range("E" & myC.Value) = myC.Offset(0, 4) .Range("F" & myC.Value) = myC.Offset(0, 5) End With Range("A" & myC.Row & ":F" & myC.Row).ClearContents Next MsgBox "更新しました" End Sub
- ベストアンサー
- オフィス系ソフト
- マクロエラー
実行時エラー１００４結合セルの一部を変更することができません と表示されました なぜでしょうか？ 以前まで使用できていたのですが Sub 作成() Dim MySheetName As Variant MySheetName = InputBox("シート名を入力してください") If MySheetName = "" Then Exit Sub Sheets("原本").Copy After:=Sheets(Worksheets.Count) ActiveSheet.Name = MySheetName Sheets("1").Range("A1:K73").Copy Sheets("原本").Range("A1") End Sub Sheets("1").Range("A1:K73").Copy Sheets("原本").Range("A1") この部分で黄色く表示されます
- ベストアンサー
- Excel（エクセル）
- EXCEL2000で作成したマクロが2007で動作しない
EXCEL2000で作成したマクロがEXCEL2007上で動作しません。 2つのシートに入ったデータを，「抽出」シートにコピー後， 抽出条件に合わせて抽出するというものなのですが， 「Sheet1」で最終行を取得するところで，正しい範囲を 選択しません。どこが間違えているのか，ご指南頂けないでしょうか? お願いいたします。 下には，正しい結果が出ない所までを貼りつけました。 Sub フィルタオプション() Dim LastRow As Long, LastColumn As Long Dim myData As Range Dim myCriteria As Range Sheets("Sheet1").Select Rows("1:1").Select Selection.Copy Sheets("抽出").Select Rows("3:3").Select ActiveSheet.Paste If Worksheets("Sheet1").FilterMode = True Then Worksheets("Sheet1").ShowAllData End If With Worksheets("Sheet1") LastRow = .Cells(Application.Rows.Count, "A").End(xlUp).Row End With Sheets("Sheet1").Select Range(Rows(2), Rows(LastRow)).Select Selection.Copy Range("A1").Select Sheets("抽出").Select Range(Rows(4), Rows(4)).Select Selection.Insert Shift:=xlDown
- 締切済み
- Visual Basic
- 特定の文字を含むシートを選択するには
いつもお世話になっております。 特定の文字を含むシートのデータをコピーするにはどのようにしたらよろしいでしょうか。 具体的には (1)シート名の末尾に"D"を含むシートを選択 (2)選択したシートのデータをコピー (3)コピーしたデータを順次"Sheet1"に貼付 というマクロを組みたいのですが、(1)のところがうまくいきません。 以下のように作成してみました。 Dim sh As Worksheet Dim lr As Long, tlr As Long For Each sh In Worksheets If sh.Name = "*D" Then lr = sh.Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row sh.Rows("3:" & lr).Copy tlr = Sheets("Sheet1").Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row Sheets("Sheet1").Range("A" & tlr + 1).PasteSpecial End If Next 4行目の sh.Name = "*D" のところがうまくないようです。 よろしくお願いします。
- ベストアンサー
- Visual Basic
補足
この方法を試したところ、"ALL"の１行目から使用されるようになりましたが、どういうわけか、6番目のシートの最終行が抜けて統合されてしまいます。シートの位置を移動しても、6番目のシートの最終行が抜けて統合されてしまいます。バグですかね？ Windows Vista HOME と Office2007 です。