マクロを使って特定シートから値を抽出し、別シートへ反映して印刷する方法

このQ&Aのポイント
  • 質問者は、特定のシートから値を抽出し、別のシートに反映し、さらに印刷したいと考えています。
  • 質問者が試したマクロではうまく動作しなかったため、修正方法を求めています。
  • 質問者のマクロでは、データベースシートの特定の行にフラグを立て、通知書シートの特定のセルにその行の社員番号を反映させて印刷する処理を行っていました。
回答を見る
  • ベストアンサー

【マクロ】特定シートから値を抽出し、別シートへ反映して印刷

【マクロ】特定シートから値を抽出し、別シートへ反映して印刷 このようなマクロを組みたいです。 作成しましたがうまく動きません。 どなたか修正していただけませんか? 【やりたいこと】 シート名1『データベース』 シート名2『通知書』 (1)『データベース』  4行目からデータベースが作成された表  C列は社員番号の列 ↓ (2)『データベース』シートのA列に『1』のフラグを立てる ↓ (3)『通知書』のセルB1に自動的に(2)で立てた行のC列の社員番号が反映され  同時に通知書シートを印刷をする。 【組んでみたマクロ】 Dim i As Integer 'カウント用変数 Dim lastrow As Integer '最終行が入る変数 i = 4 '最初に始まる行数を指定 lastrow = ActiveSheet.Range("A65536").End(xlUp).Row '最終行を取得する For i = 4 To lastrow '最終行まで繰り返す If Worksheets("データベース").Range("A" & i & "") = 1 Then 'A列に「1」があったものは以下の処理をする '別シートの特定セルを取得する Worksheets("通知書").Range("B1") = "=INDIRECT(""データベース!""&""C" & i & """)" '社員番号 '印刷する Sheets("通知書").PrintOut Else 'A列に「1」がなかったら以下の処理をする End If 'A列に何かあるかの判別終了 Next i '繰り返しの終わり。i(カウント用変数)に1を足す End Sub

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

  • ベストアンサー
  • mo2yakko
  • ベストアンサー率54% (30/55)
回答No.2

どういう動作をしてしまっているのかが書かれていないので判らないです。 強いて言うならここかもです。 ↓なにがアクティブなシートなのか不明 lastrow = ActiveSheet.Range("A65536").End(xlUp).Row '最終行を取得する シートを指定すると、どうでしょうか? lastrow = Worksheets("データベース").Range("A65536").End(xlUp).Row '最終行を取得する

その他の回答 (1)

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

【手直しマクロ】 sub macro1r1()  ’「行番号」の最大値はIntegerの上限値を超える可能性があるので直すこと  Dim i As Long  Dim lastrow As Long  ’「現在のシート」がデータベースではないと失敗するので直すこと  lastrow = worksheets("データベース").Range("A65536").End(xlUp).Row  ’「For i =」でiは初期化されるので,事前に初期値をセットする必要はない  For i = 4 To lastrow '最終行まで繰り返す   ’簡素化   If Worksheets("データベース").Range("A" & i) = 1 Then    ’適正化および簡素化    Worksheets("通知書").Range("B1").value = worksheets("データベース").range("C" & i).value    ’念のため    worksheets("通知書").calculate    Sheets("通知書").PrintOut   ’簡素化   End If  Next i End Sub 以上のように直した方が良い箇所は幾つか見受けられますが,致命的にマクロが間違っている箇所は(Integerを除いて)ありません。 肝心の >うまく動きません。 の具体的な症状,いったいこのマクロでどうあるべき所がどうなってしまって何が問題になっているのか,ご相談にしっかりと明記するようにしてください。 ●通知書の印刷結果が全く間違えている  単純にこのマクロに関係なく,シートに投入してある数式等が間違っている場合もよくあります。  マクロ以前に手動で通知書の所定のセルにデータを記入し,数式等が正しく計算結果を出すことを再確認してください。 ●通知書の印刷結果が時々更新されていない  この手のマクロにすると,画面の更新が間に合わないまま印刷に走ってしまい印刷結果が適正でなくなる場合があります。  手直し例ではシートの再計算を明示的に行わせましたが,場合によっては更に「application.wait now + timeserial(0,0,3)」などのようにして,少し待ちを入れた方が良い事もあります。

関連するQ&A

  • VBA マクロ シート 転記

    はじめまして。VBA初心者です。今シート1のA列1行目セルにA社、A列2行目にB社、A列3行目にC社と・・ざっと1000行程あり、それぞれB列には値があります。この値をシート2のB列に転記したいと思っています。ただ、毎月シートを追加していきますので、左隣のシートから転記しなければなりません。シート2の項目は同じA列とB列で構成されています。A列の値が多少前後するので、FINDを使って以下のようなプログラムを作りました。ただ、左隣のシートから転記とう内容をどうやって追加したら良いのかがわかりません。Previous をどこかに使えばできるのかなとも思うのですが、その方法がわかりません。 Sub 転記() Dim ws As Worksheet, ws1 As Worksheet, r As Range, r1 As Range Dim LastRow As Long, i As Long, er As Long, wkey As String Set ws = Worksheets("Sheet1") Set ws1 = Worksheets("Sheet2") LastRow = ws.Range("A1").End(xlDown).Row er = ws1.Range("A1").End(xlDown).Row Set r = ws.Range("A1:A" & LastRow) For i = 1 To er wkey = ws1.Range("A" & i) Set r1 = r.Find(What:=wkey, LookIn:=xlValues, LookAt:=xlWhole) If Not r1 Is Nothing Then ws1.Range("B" & i) = r1.Offset(, 1) End If Next Set r1 = Nothing Set r = Nothing Set ws = Nothing Set ws1 = Nothing End Sub どなたか詳しいお方いらっしゃいましたら、初心者の私に教えて頂けませんでしょうか?宜しくお願いします。

  • 選択したセルの値を別シートのセルに取り込む方法

    顧客情報を閲覧・印刷するためのフォームがsheet1とします。顧客の情報が入ったデータベースがsheet2とします。 以下のマクロでsheet2の48列目を空欄にして、48列のいずれかのセルに「出力」と入力すると、そのセルの行の値を出力結果というシートに渡すようにしています。取り込んだ行の顧客番号をsheet1のmach関数の参照先に指定して、index関数で各項目に取り込むようにしています。 Worksheets("sheet2").Activate Dim i, LastRow As Long LastRow = Cells(Rows.Count, 48).End(xlUp).Row For i = 1 To LastRow If Cells(i, 48) = "出力" Then Rows(i).Copy Sheets("出力結果").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i もう少しこれを改良して、Sheet2の顧客番号の入っている1列目の任意のセルを選択して、sheet1のmatch関数の参照先(例としてK4)に選択した顧客番号を渡す方法はありませんでしょうか。sheet1は顧客番号だけ取得できれば、match・index関数でフォームが完成します。 VBAは初心者です。上記マクロは検索で調べて必要な個所をコピーして今の環境にアレンジしました。よろしくお願いします。

  • エクセルマクロ シート間の照合_上書き

    マクロ初心者です。(エクセル2003使用) Sheet2の管理番号をSheet1の管理番号と照合し、同じであれば、数量など3項目を上書きするマクロを作ろうとしています。 (Sheet1:日々更新される元データ)全データ数約500件くらい A列   ,B,  C,  D,   ・・・ 1行 管理番号,品名,注文数量,出荷数量,・・・ (Sheet2:上書きさせたいシート)全データ数約80件くらい G列   ,H,  I   J      9行 管理番号,品名,注文数量,出荷数量 ↑シート2にある管理番号をもとに数量などを照合&上書きをしたいのです。 ■シート1も2も行数は日々変動します。 ■シート1で、まれに同じ管理番号が2つ存在することがありますが、取り出したい数量などのデータは、常に1番目に照合する管理番号です。 Sub シート間照合と上書き() Dim i As Integer a = Worksheets("sheet1").Range("a65536").End(xlUp).Row For i = 2 To a If Worksheets("sheet1").Range("A2") = Worksheets("sheet2").Range("G9") Then Worksheets("sheet1").Cells(1, i) = Worksheets("sheet2").Range("G9") Worksheets("sheet1").Cells(2, i) = Worksheets("sheet2").Range("H9") Worksheets("sheet1").Cells(3, i) = Worksheets("sheet2").Range("I9") While Cells(1, i) <> "" i = i + 1 Wend End If Next End Sub ■上記 模索しながらマクロを作ってみたのですが、エラーにはならないのですが(F8)、まったく動きませんでした。 すみませんが、お力をかしてください。 よろしくお願いいたします。

  • マクロで分と秒だけのデター抽出を教えてください。

    マクロで分と秒だけのデター抽出を教えてください。 シート1のA列に5:15:30以下にランダムな時刻が入力されています。(時間と分と秒が表示になっています。) それを分と秒だけシート2のA列に表示したいと思っています。 とりあえず、データーだけでもシート2に移せたら(転記)と思い以下の記述をしたのですが、 これでは、時刻データーも29035.0658333333となったりA列以外のデーターも 全部転記してしまいます。 誰か教えて頂けませんでしょうか?お願いします。 Sub データー抽出() Dim LastRow As Long Dim k As Long LastRow = Worksheets("シート1").Range("A65536").End(xlUp).Row For r = 2 To LastRow Worksheets("シート2").Rows(r).Value = Worksheets("シート1").Rows(r).Value Next r end sub

  • エクセル2003 別シートへ抽出して印刷するマクロについて

    エクセル2003 別シートへ抽出して印刷するマクロについて Sheet1のデータ(1~60のナンバーを入れています)を、Sheet2のA1にナンバーを入力、 関数を反映させた同一の印刷範囲を繰り返し印刷させるマクロについて教えてください。 下記マクロで ActiveSheet.PrintOut Copies:=1 のところでファイルの保存の窓が出てきてしまいます。 種類はXPSだけで選択はできないようです。 こんな窓が出てくるのも不思議ですが、 vistaではない(XPです)のにXPSというのも不思議です。 保存窓の後ろには印刷中の窓が出ています(印刷はされません) キャンセルで窓を閉じるとエラー400がでます。 どういった修正をしたらいいのか教えてください。 よろしくお願いいたします。 Sub SAHIKOMI() Dim SNO As Integer, ENO As Integer, I As Integer SNO = InputBox("開始No.を入力") ENO = InputBox("終了No.を入力") Sheets("Sheet2").Activate For I = SNO To ENO Worksheets("Sheet2").Range("A1") = I ActiveSheet.PrintOut Copies:=1 Next I End Sub

  • マクロでキーワードを抽出して別のシートに貼り付けする

    セルA列にキーワードCCCが含まれていた場合に その行を削除してSheet2に貼り付けをしたく、下記のソースを 書いてみましたがエラーがでてしまいます。 どこが間違っているか添削していただけないでしょうか? Sub キーワード切取貼付() Dim r As Range For Each r In Range("A1", Range("A65536").End(xlUp)) Do Set r = Range("A:A").Find(What:=CCC, LookAt:=xlPart) If r Is Nothing Then Exit Do r.Worksheets("Sheet1").Range("A:A").Cut r.Worksheets("Sheet2").Range("A1").PasteSpecial Loop Next End Sub

  • データの値取得マクロ

    Sub Macro1() ''Worksheets("Sheet1").Activate ' addrw = Range("b65536").End(xlUp).Offset(1).Row Cells(addrw, 2).PasteSpecial end sub でB列の最終行を取得しその後、最終行の次のセルから追加のデータを貼り付けるマクロを作成しました。 このあと、追加のデータを貼り付ける前のB列の最終行の値と貼り付け後のB列の最終行の値を取得したいのですがどうすればいいでしょうか?

  • エクセル マクロ IF関数について

    Sheet1にグループボックス内で、チェックボタンで項目を選択するとA1に記載されるように作成、マクロで入力ボタン作成しボタンをクリックするとSheet2に記載されるように作りました。しかし、項目が多いためSheet2を見るとABCDEFGなどの列に空白が目立ち使いづらいです。 そこでIF関数を使い何とか出来ないでしょうか? 例)SHEET1 B2に原因のグループボックスにカテゴリー(チェックボックスにて1)入力ミス、2)人、3)機械) B3に対応のグループボックスにカテゴリー(チェックボックスにて1)外注、2)修正、3)報告) と作り、それらがチェックされていたら、A1の列に表示され入力ボタンを押したら、Sheet2のAには原因、Bには対応と記載されるようにしたいです。その時Sheet1のA列に空白があれば、Sheet2の列に表示するようにしたいです。 実際のマクロ記入 Sub 入力() Dim LastRow As Long With Worksheets("Sheet2") LastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & LastRow).Value = Worksheets("Sheet1").Range("A6").Value .Range("B" & LastRow).Value = Worksheets("Sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("Sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("Sheet1").Range("A9").Value .Range("E" & LastRow).Value = Worksheets("Sheet1").Range("A10").Value .Range("F" & LastRow).Value = Worksheets("Sheet1").Range("A12").Value .Range("G" & LastRow).Value = Worksheets("Sheet1").Range("A13").Value .Range("H" & LastRow).Value = Worksheets("Sheet1").Range("A15").Value .Range("I" & LastRow).Value = Worksheets("Sheet1").Range("A16").Value .Range("J" & LastRow).Value = Worksheets("Sheet1").Range("A19").Value End With End Sub お願いします教えてください。

  • マクロで封筒を自動印刷

    マクロで封筒を自動印刷出来る様にファイルを作りました。 先日、そのマクロで封筒を印刷する前に 別のファイルの物を印刷しようと思い、そのファイルの印刷設定を変えて 印刷をしました。 その後、マクロで作ったファイルで封筒を印刷したところ 印刷設定がおかしくなってしまいました。 とりあえず、設定を直し何度かマクロで印刷を試みましたが いくら直して上書きしても印刷設定が直らず・・・・。 一度、PCを再起動して再び試みると印刷がきちんとされました。 この現象はマクロを使っているからなのでしょうか?? それともマクロの使い方が悪くて起きる症状なのでしょうか? 対策方法があれば教えて頂けるとうれしいです。 使っているマクロは次のとおりです。 Sub Futo_Copy() '////////////////////////////// '印刷を行う '////////////////////////////// Dim i As Integer Dim S_1 As String '1行目 Dim S_2 As String '2行目 Dim S_3 As String '3行目 Dim S_4 As String '4行目 Dim S_5 As String '5行目 Dim S_6 As String '6行目 Dim S_7 As String '7行目 Dim S_8 As String '8行目 Dim S_9 As String '9行目 Dim S_10 As String '10行目 Application.ScreenUpdating = False '描画をしない 'sheet_name = ActiveSheet.Name 'アクティブシート名を取得 'シートの中で使用されている最大の列を求める。 'row_count = Worksheets("印刷対象").Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row 'シートの中で使用されている最大の行を求める。 'col_count = Worksheets("印刷対象").Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column row_count = Worksheets("印刷対象").Range("A65536").End(xlUp).Row For i = 3 To row_count '印刷対象の3行目からループ Worksheets("出力").Select 'データ取得 S_1 = Worksheets("印刷対象").Cells(i, 1) S_2 = Worksheets("印刷対象").Cells(i, 2) S_3 = Worksheets("印刷対象").Cells(i, 3) S_4 = Worksheets("印刷対象").Cells(i, 4) S_5 = Worksheets("印刷対象").Cells(i, 5) S_6 = Worksheets("印刷対象").Cells(i, 6) S_7 = Worksheets("印刷対象").Cells(i, 7) S_8 = Worksheets("印刷対象").Cells(i, 8) S_9 = Worksheets("印刷対象").Cells(i, 9) S_10 = Worksheets("印刷対象").Cells(i, 10) Worksheets("出力").Cells(1, 1) = S_1 Worksheets("出力").Cells(2, 1) = S_2 Worksheets("出力").Cells(3, 1) = S_3 Worksheets("出力").Cells(4, 1) = S_4 'Worksheets("出力").PrintPreview 'プレビュー Worksheets("出力").PrintOut 'プリントアウト Next i 'Worksheets("出力").Cells.Clear 'シートのクリア Application.ScreenUpdating = True '描画開始 Worksheets("印刷対象").Activate End Sub 出来ればこのマクロの形をあまり変えずに 症状が直せるといいのですが・・・。 よろしくお願い致します。

  • 【VBA】SUMIFを別シートから参照する方法

    半端な知識で切り張りして書きましたが SUMIFのコードでコンパイルエラーとなります。 ご教示宜しくお願いします。 'ws1は、アクティブシート(=SUMIFを入力するシート) Set ws1 = Worksheets("アクティブシート") 'ws2は、参照するシート Set ws2 = Worksheets("参照するシート") 'Hani1は、ws2のA2セルから最終行迄 Set Hani1 = ws2.Range("A2:A" & LastRow) 'Hani2は、ws2のH2セルから最終行迄 Set Hani2 = ws2.Range("H2:H" & LastRow) 'n4はアクティブシートの2行目から最終行迄 For n4 = 2 To LastRow2 'アクティブシートのCn4セルから順に、An4セルに合致するものについて Hani1、Hani2を参照してSUIFする Range("C" & n4).Formula = _ "=SUMIF(Hani1,ws1.Range("A" & n4),Hani2)" Next n4

専門家に質問してみよう