• ベストアンサー

VBAのシートコピーで時間が・・・

fumufumu_2006の回答

回答No.1

ちがってたらすみません。 .Protect 保護して変更を禁止 .EnableCalculation = False '再計算禁止 を勘違いしてませんか？ p.s. 全部の作業が終わったら、最後に .EnableCalculation = True を実行しないと、再計算しません。

この回答がついた質問に戻る
回答 全件
ベストアンサー
http://www.relief.jp/itnote/archive…
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • VBA中の”シート名”を”アクティブシート”に変更

    いつもお世話になっております。 非常に初歩的な質問なのですが、下記の2つのVBA中のシート名をアクティブシートに変更したいのですが、 sheetName = ActiveSheet.Name で試行錯誤するもうまくいきません。 実際のコードは下記の通りです。 これらのシート名”申請書”をアクティブシートに変更したいのです。 このコードは過去にここで教えて頂いたコードで出来ればこれを修正したいので宜しくお願いします。 １．Sub 申請書登録() Dim NewBookName As String With ThisWorkbook.Sheets("申請書") Windows("1.新規・変更登録申請書(原紙)･ﾘｽﾄ②T用.xlsm").Activate For i = 5 To Sheets("規格登録・変更ﾘｽﾄ").Range("A1048576").End(xlUp).Row + 1 If Sheets("規格登録・変更ﾘｽﾄ").Range("B" & i).Value = "" Then With Sheets("規格登録・変更ﾘｽﾄ") .Range("A" & i).Value = Sheets("申請書").Range("E3").Value .Range("B" & i).Value = Sheets("申請書").Range("O3").Value .Range("C" & i).Value = Sheets("申請書").Range("E4").Value ・・・・・・・・・・・・・・・・・・・ 2.Sub 申請書保存() Dim NewBookName As String With ThisWorkbook.Sheets("申請書") NewBookName = .Range("F22").Value & " " & .Range("E4").Value & " " & .Range("A2").Value & " " & .Range("A1").Value Worksheets("申請書").ExportAsFixedFormat Type:=xlTypePDF, Filename:="\***\XXXX\1.申請書\申請書" & "\" & NewBookName End With End Sub

  • VBA シートをコピーした時、同名の場合は注意喚起

    いつもお世話になります。 WINDOWS7 EXCELL2010 です。 下記のマクロで例えば、 「1018」というシートが既に存在していて新たに「1018」を作成しようとした時に重複の注意喚起メッセ―ジを出すには下記のマクロにどうすればいいか御指導いただけませんでしょうか。 注意喚起メッセージは　　「既に、同名のシートがあり再度入力して下さい。」 ※If MsgBox("既に、同名の シートがあり再度入力して下さい。") 参考に Private Sub CommandButton1_Click() Dim NewSheetName As String NewSheetName = InputBox("一桁の月及び日でも二桁のMMDD形式で新しいシート名を入力してください。例 0101") Sheets("元本").Copy After:=Sheets("元本") With ActiveSheet .Name = NewSheetName With .Range("A1") .NumberFormatLocal = "0000" .Value = NewSheetName End With .OLEObjects("CommandButton1").Delete .Range("A2").Select End With Sheets("元本").Activate Application.ScreenUpdating = True End Sub

  • VBA コマンドボタンにおけるコードについて

    下記のようなコードを作成しました。 これを簡略化するにはどうすれば良いのでしょうか？ よろしくお願いします。 Private Sub CommandButton1_Click() Sheets("sheet2").Select Select Case UserForm1.ComboBox1.Text Case Is = Sheets("sheet2").Range("A1").Value Sheets("sheet2").Range("B1").Value = "X" Case Is = Sheets("sheet2").Range("A2").Value Sheets("sheet2").Range("B2").Value = "X" Case Is = Sheets("sheet2").Range("A3").Value Sheets("sheet2").Range("B3").Value = "X" Case Is = Sheets("sheet2").Range("A4").Value Sheets("sheet2").Range("B4").Value = "X" Case Is = Sheets("sheet2").Range("A5").Value Sheets("sheet2").Range("B5").Value = "X" ・ ・ ・ End Select End Sub

  • EXCEL VBA　オートフィルで別シートへコピー

    EXCEL VBA　オートフィルで別シートへコピー しようとしたら、うまくいきません 別々に書くとうまくいくのですが コードを一緒にするとうまくいきません？ コード *********************************************** Sub 抽出別シート() Worksheets("時間合計VB").Select ' 時間合計VBのシートを選択 Range("A1").AutoFilter field:=8, Criteria1:="<=1" '１時間以下の８列目のをフィルター end sub sub カレントで別シートへコピー() Range("A1").CurrentRegion.Copy Sheets("1hdown").Range("A1") 　　'それをカレントして別シートのＡ１へコピー Range("A1").AutoFilter End Sub *********************************************** このように書くとうまくいくのですが これを一緒に書くと別シートへコピーがうまくいきません。 全てコピーされてしまいます +++++++++++++++++++++++++++++++++++++++++++++++ 一緒にしたコードです +++++++++++++++++++++++++++++++++++++++++++++++ *********************************************** Sub 抽出別シート() '1h以下をを抽出別シートへコピー Worksheets("時間合計VB").Select ' 時間合計VBのシートを選択 Range("A1").AutoFilter field:=8, Criteria1:="<=1" 　　 '１時間以下の８列目のをフィルター Range("A1").CurrentRegion.Copy Sheets("1hdown").Range("A1") 　　 'それをカレントして別シートのＡ１へコピー Range("A1").AutoFilter End Sub *********************************************** 意味が分かりませんどなたかおしえていただけませんでしょうか？ よろしくお願いいたします

  • VBAでシートのコピー

    お世話になっております。 VBAの未熟者ですが、個人の資料作成のためのシステムをコツコツと作っております。 今までマクロでシートのコピーをやっていたのですが、コマンドボタンでできるように変更しようとしてうまくいきません。 ファイルＡの中にある幾つかのシートの内、シート「個人事業」を「請求書」ファイルの「Sheet2」にコピーしたいのです。その後名前を変更しています。 マクロのプログラムをそのままコピーしてみたのですが、[sheets("個人事業").paste]のところでエラーが出ます。 マクロとコマンドボタンではやはり設定を変更しないといけないのでしょうか？ご教授お願いします。 Private Sub CommandButton1_Click() Sheets("Sheet2").Select Windows("未請求リスト.XLS").Activate Sheets("個人事業").Select Selection.Copy Windows("請求書.xls").Activate Sheets("Sheet2").Select Sheets("個人事業").Paste Sheets("Sheet2").Name = "個人事業請求一覧" Sheets("請求書").Select End Sub 宜しくお願いします。

  • エクセルＶＢＡ：コピーの貼り付け先

    ＶＢＡ初心者です。よろしくお願いします。 あるデータベースをセルB2に入力されている値で絞込み、 シート２に貼り付けるとき、下記の(1)がおそらく正解だと思いますが、 ★（質問１) (2)でも同じ結果が得られました。コピー先の目的地を示す「Destination:=」の部分は省略して全く問題なしと考えてよろしいのでしょうか？ ★（質問２) (3)で試してみても同じ結果が得られました。range("sheet2!A1") なんて書き方は、たまたま、試してみたらできちゃった（同じ結果が得られた）のですが、使い方として問題ありませんか？ ------------------------------------------------------------- (1) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Destination:=Sheets("Sheet2").Range("A1") .AutoFilter End With End Sub -------------------------------------------------------------- (2) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Sheets("Sheet2").Range("A1") .AutoFilter End With End Sub -------------------------------------------------------------- (3) Sub test01() With Range("A1") .AutoFilter field:=2, Criteria1:=Range("B2") .CurrentRegion.Copy Range("Sheet2!A1") .AutoFilter End With End Sub

  • 指定記号のみ別シートにコピー

    sheet1（表-1）の入力文字「A,C,E」をsheet2へコピーする。 sheet2（表-3)のように[A,C,E」以外及びsheet1空白のセルはsheet2でも空白としたい。 その際、sheet2（表-2)に入力済みの記号「○、●、◎」はそのまま残したい。 下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。 どなたかコードがわかる方よろしくお願いします。 Sub シートコピー() Dim r As Range For Each r In Worksheets("Sheet1").Range("B1:D5") If WorksheetFunction.CountIf(Range("A8:A10"), r.Value) Then Sheets("sheet2").Range(r.Address).Value = r.Value Else Sheets("sheet2").Range(r.Address).Value = "" End If Next End Sub セルA11に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。

  • VBA空白を除いてコピーが出来ません。ご指導お願いします。

    値のコピー＆ペースト（空白を除いてコピー）したいと思っております。 シート１　の　A35、D35、I35　をコピー。 シート２　の　A2　に貼り付け。 これは、大丈夫です。 シート１　の　M2　：　O23　をコピー。 シート２　の　E2　に貼り付け。 今回の場合ですと、M2　：　O13　までに値が入ってます。 ですので、M14　：　O23　までが、空白になって記入となってしまいます。 ＊毎回、値が入る量が違います。 一回のコピーですと、これでもいいのですが、 値を変更して、コピーを続けてしますので、M14　：　O23　までが、空白になってM24からのコピーになってしまいます。 空白を除いて、貼り付けしたいのですが、 どうすればいいのかわかりません。 お分かりになる方、ご指導よろしくお願いします。 VBAは以下になっております。 Sub Macro1() ' Application.ScreenUpdating = False Sheets("Sheet1").Range("A35,D35,I35").Copy If Sheets("Sheet2").Range("A2").Value = "" Then Sheets("Sheet2").Range("A2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Sheets("Sheet1").Range("M2:O23").Copy If Sheets("Sheet2").Range("E2").Value = "" Then Sheets("Sheet2").Range("E2").PasteSpecial Paste:=xlPasteValues Else Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub よろしくお願いします。

  • ＶＢＡ　別シートからコピー貼付け（複数列）

    別シートからコピー貼付け（複数列）をしたいのですが，同一シートからのコピー貼付けはネットから以下のマクロでできました。 しかし，別シートsheet1からsheet2ヘコピーで修正しましたが，「アプリケーション定義またはオブジェクト定義のエラーです。」となります。どなたかご教授よろしくお願いします。 修正したマクロ Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Sheets("sheet2").Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Sheets("sheet1").Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub 参考としたマクロ http://www.excel.studio-kazu.jp/kw/20041208152106.html Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub

  • リストからフォーマットをコピーしてワークシートを追加するマクロについて

    マクロを勉強し始めたばかりで、いろいろ見ながらやっていますが、つまずいてしまいました。 やりたい事、コード、エラーになっているところは以下の通りです。 解決方法をご教示下さい。 【やりたい事】 あるデータリスト（sheet1）から1行ずつ、見積書を作成する (1)見積書format（sheet2）をコピーし、表示されているsheetの後に追加 (2)シート名称を"取引先コード_部番"に変更 (3)sheet1のデータをコピーされたformatに転記 (4)作成対象列に「*」が入っているデータのみ対象とし、ループ処理 　※(4)はコードがわからず、うまく出来ていません。 【コード】 --------------------------------------------------- Sub Macro1() 作成対象 = Sheets(1).Range("A2") 取引先コード = Sheets(1).Range("B2") 部番 = Sheets(1).Range("C2") 　金額 = Sheets(1).Range("C2")　 no = Sheets.Count i = 0 Do Until 作成対象 = "" i = i + 1 Sheets(2).Copy after:=Sheets(no) no = no + 1 Sheets(no).Name = "見積書（" & 取引先コード & "_" & 部番 & ")" Range("B11").Value = 取引先コード Range("AF13").Value = 部番 Range("BB13").Value = 金額 媒体No. = Sheets(1).Range("M2").Offset(i, 0) Loop End Sub --------------------------------------------------- 【エラー】 １行目のデータは意図どおり処理されますが、2行目以降、以下のコードでエラーになります。 どうも、シート名が同じになってしまう為のようです。 Sheets(no).Name = "見積書（" & 取引先コード & "_" & 部番 & ")"

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する
質問する