• ベストアンサー
  • 困ってます

エクセル マクロの設定方法について

差込印刷でSheet1に作成した名簿データにより、sheet2に作成しているデータへ差込印刷をしています。現在、次のようなマクロを組んで名簿の件数に合わせて、For = 2 To 500 Step 8を修正しながら、印刷しています。できたら、名簿の件数の増減に関係なく印刷できるようになればと考えています。始めたばかりのマクロ初心者です。よろしくご教授ください。お願いします。 Dim i As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = sheets(″sheet1″) Set ws2 = sheets(″sheet2″) For i = 2 To 500 Step 8 ws2 .Range(″A1″).Value = ws1.Cells(i+1,2).Value ws2 .Range(″A7″).Value = ws1.Cells(i+2,2).Value ws2 .Range(″A13″).Value = ws1.Cells(i+3,2).Value ws2 .Range(″A19″).Value = ws1.Cells(i+4,2).Value ws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ws2 .Range(″F7″).Value = ws1.Cells(i+6,2).Value ws2 .Range(″F13″).Value = ws1.Cells(i+7,2).Value ws2 .Range(″F19″).Value = ws1.Cells(i+8,2).Value DoEvents ws2.PrintOut Next End Subws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ネット等で調べて、上記のようなマクロで作業してます。(マクロの設定方法が間違っているところがあると思いますが?)

noname#142195

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数301
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.3
  • tom04
  • ベストアンサー率49% (2537/5117)

こんばんは! コードの記述方法はひとそれぞれですので、これでないとダメ!ということはないと思います。 一例ですが↓のような感じではどうでしょうか? Sub 印刷() Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Sheets("sheet1") Set ws2 = Sheets("sheet2") For i = 2 To ws1.Cells(Rows.Count, 2).End(xlUp).Row Step 8 With ws2.Cells(1, 1) .Value = ws1.Cells(i + 1, 2) .Offset(6) = ws1.Cells(i + 2, 2) .Offset(12) = ws1.Cells(i + 3, 2) .Offset(18) = ws1.Cells(i + 4, 2) .Offset(, 5) = ws1.Cells(i + 5, 2) .Offset(6, 5) = ws1.Cells(i + 6, 2) .Offset(12, 5) = ws1.Cells(i + 7, 2) .Offset(18, 5) = ws1.Cells(i + 8, 2) End With ws2.PrintOut Next i End Sub ※ 質問内容からすると、 >For i = 2 To ws1.Cells(Rows.Count, 2).End(xlUp).Row Step 8 の部分が一番のご希望だったのでしょうかね?m(_ _)m

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • エクセルでのマクロを使った参照

    教えてください。 シート1のB23:F73のデータをシート2に張りつけたいのですが、 その際にB列には連番で1~50の数字が入っており C、D列にはデータが有る場合とない場合があります。 データがある場合は必ず対で存在します。 貼り付けの際にC、D列にデータのある行のみ B、C、D列のデータを連続で並ばせたいのですが、 どのようにマクロを組んだらよろしいですか? 手元に資料もなく、困ってしまいました。 よろしくお願いします。 現在のマクロは以下の通りです Sub TEST4() Dim S1 As Worksheet, S2 As Worksheet Set S1 = Worksheets("SHEET1") Set S2 = Worksheets("SHEET1") S2.Range("A1:E51").Value = S1.Range("B23:F73").Value End Sub

  • Excel マクロの一部改造の方法を教えて下さい。

    先日、tom04さんから下記のマクロを教えていただきました。 sheet1のセルA1にsheet2のセルA1からA??までの項目を順次入れ、sheet1を印刷するものです。 これに、追加でsheet1のセルB1にも項目を追加したいのです、データーはsheet2のB1から入れておくこととします。 下記のマクロを教えて下さった、tom04さんの目にとまれば幸いですが、内容を理解して頂いた方ならどなたでも回答頂ければ幸いです。よろしくお願い致します。 改造して頂きたいマクロは下記です。 Sub test() 'この行から Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("sheet1") '←Sheet名は適宜変更してください Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更 For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("A1") = ws2.Cells(i, 1) '←Sheet1のA1セルに名前を表示 ws1.PrintOut Next i End Sub 'この行まで

  • エクセルのマクロについて

    下記のようなプログラム組んでいます。 Sub 張付() Sheets("一覧表").Select Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("一覧表") Set ws2 = Worksheets("データー") For i = 5 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("B5") = ws2.Cells(i, 2)    'セルB5に氏名を入力 ws1.Range("C5") = ws2.Cells(i, 3)    'セルC5に年齢を入力 ws1.Range("D5") = ws2.Cells(i, 4)    'セルD5に電話番号を入力 この後、 ws1.Range("B5")のB5をB6にまた、C5はC6に改行してそれぞれデーターを移していきたい のですが、B5をB6に順次プラスする方法を教えて下さい。 よろしくお願いいたします。

その他の回答 (2)

  • 回答No.2
  • imogasi
  • ベストアンサー率27% (4568/16357)

>マクロの設定方法について この言い回しはつかわない。設定は他に意味がある。VBAのコードを作ってくれ、でしょう。 丸投げで頼りすぎだが。 ーー どういうデータ状態なのか特にSheet1の例ぐらい挙げて質問を説明すること。 普通はSheet1の1行データの各列(=諸項目)を、Sheet2の適当な決った場所(セル)にセットして、1ぎょうで1 .PrintOutして、Shet2の変わるセルをクリアして、行数分繰返すものだが。 そのSheet2の帳票設計が8行おき、というのも理由が説明されてなくて解せない。 Sheet1のデータも1印刷シートあたり、Sheet1のB列から8行分セットして作成しているが、意味がわからない。 ーー 初心者は、我流の、間違ったり、拙いコードを掲示して、読者・回答者に読み解かせると、混乱したり質問の意図をミスリードすることが多い。 質問では、やりたいことをデータ例を掲示して、文章を添えて、説明することに注力すべきだ。 ーーー 普通のケースでは、 繰り返しはSheet1の(各)行 繰返し(For Nextなど)の終了条件はSheet1のデータ最終行 Sheet2は、Sheet1の「いま処理している行の各列」からSheet2のセル(散らばっているので、しかし在る項目は、同じセル位置のはずなので)に、くり返しではなく、具体個別的にコード複数行でセルを指定する記述になると思う。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答いただきありがとうございました。 初めての質問でしたので、言い回し等が悪く申し訳ありませんでした。 sheet1に次の項目で名簿データを作成しています。 A列(番号)B列(業者名)C列(名前)D列(住所)E列(備考) sheet2は、1ページに同じ様式の名札を8枚(8名分)作成しています。 その名札には、番号、業者名、名前を差込印刷できるようにしています。 できれば、今のマクロを利用してA列が空欄になったら、印刷を終了させることができるのか教えていただきたかっただけです。 質問の仕方が悪く、申し訳ありませんでした。

  • 回答No.1

名簿の途中に空行がないなら、「500」の代わりに [B2].End(xlDown).Row が使えます。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答いただきありがとうございました。 マクロ初心者ですので、これからも色々と試したいと思います。

関連するQ&A

  • Excel 2007 マクロのIF構文について

    Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、 必要な情報を転記するマクロです。 下記マクロで実現できているのですが、IF構文が多く もっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたら お教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub

  • EXCELでSheetにデータを蓄積したい

    Sheet1に入力シートを作成し、Sheet2に蓄積シートを作成しました。 Sheet1で作成されたデータをSheet2に蓄積させておきたい。 Sheet1のA2の値が入力された場合に実行するとすると Sheet1のデータ数は、毎回異なります。 他を参考に以下のように作ってみたのですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim lastA As Long, lastB As Long, ws1 As Worksheet, ws2 As Worksheet Set ws1 = Sheets("入力シート") Set ws2 = Sheets("蓄積シート") With Target If .Address <> "$A$2" Or .Count <> 1 Or IsEmpty(Target) Then Exit Sub If WorksheetFunction.Count(ws1.Range("a1:s1")) <> 19 Then Exit Sub lastA = ws2.Range("a65536").End(xlUp).Row lastB = ws1.Range(("a2:s2"), Selection.End(xlDown)).Select ws2.Range("a" & lastA + 1).Resize(1, 19).Value = _ ws1.Range("a2:S2").Resize(1, 19).Value End With End Sub 'ws1.Range("a2:S2").Resize(1, 19).Value の部分で '上記ws1の範囲の内、Row2の値しかws2へ反映されません どなたか教えて頂けないでしょうか。

  • Excel 2007 マクロ 別シートの情報を反映する方法

    Excel 2007 マクロ 別シートの情報を反映する方法 Sheet1とSheet2があります。 Sheet1のD列とSheet2のM列で同じ値があれば、 Sheet1のE列の値をSheet2のN列に反映するマクロを 作成しました。 下記が正しいと思っていたのですが、エラーメッセージは出ずに 値が反映されません。 マクロに問題点があればご指摘ください。 よろしくお願いいたします。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, "D").End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, "M").End(xlUp).Row If ws2.Cells(j, "M") = ws1.Cells(i, "D") Then ws2.Cells(j, "N") = ws1.Cells(i, "E") End If Next j Next i End Sub

  • エクセル マクロ チェックボックス

    sheet1にチェックボックスが3つあり、マクロを実行するコマンドボタンが1つあります。 チェックボックスにレ点を入れることにより、sheet4のデータからsheet2にグラフを作成しようと考えてますが、エラーが出てしまい解決できません。 どのように訂正したらいいのか教えて頂けないでしょうか。 Private Sub CommandButton1_Click() Dim GraphRange As String Dim Graph As ChartObject Dim lastRow As Long Set Graph = Sheets("sheet2").ChartObjects.Add(150, 27, 350, 200) lastRow = Sheets("sheet4").Range("A" & Rows.Count).End(xlUp).Row GraphRange = Sheets("sheet4").Range(Cells(1, 1), Cells(lastRow, 1)).Value If Sheets("sheet1").CheckBox1.Value = True Then 'CheckBox1にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 2), Cells(lastRow, 2)).Value End If If Sheets("sheet1").CheckBox2.Value = True Then 'CheckBox2にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 3), Cells(lastRow, 3)).Value End If If CheckBox3.Value = True Then 'CheckBox3にチェックがあれば GraphRange = Sheets("sheet4").Range(Cells(1, 4), Cells(lastRow, 4)).Value End If Graph.Chart.ChartWizard Source:=Sheets("sheet4").Range(GraphRange).Value, _ Gallery:=xlLine, Format:=1, PlotBy:=xlColumns, _ CategoryLabels:=1, SeriesLabels:=1, HasLegend:=True End Sub

  • エクセルVBAで範囲を変数で設定する方法?

    Dim i As Integer For i = 1 to 50 とした場合、 セルであれば Sheets("Sheet2").Cells(i, 2).Value = Sheets("Sheet1").Cells(i, 2) のように変数を使えますが、範囲に使う場合にはどう書けばいいのでしょうか? 例えば、 Sheets("Sheet2").Range("A1:G1").Value = Sheets("Sheet1").Range("A1:G1") のような式で、行数を変数にする場合です。 よろしくお願いします。

  • マクロを使って・・・

    シート1に入力したデータをシート2にコピーするいうマクロを作りました。 シート2にコピーはできるのですが 例えば、そのデータを消して再度新しいデータを入れていきたいと思い エクセル左上のシート全体を選択して「Delete」を押すと 会社のエクセル(2003?)は中断モードがどーのこーのとエラー画面が出て マクロが黄色になって、前に進めません。 やり方が決まっているのでしょうか? コピーした行全体を選択して右クリック「削除」とすると エラー画面が出ません。 やり方など決まっているのでしょうか? ↓がんばって作ったマクロです Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues  ←この行が黄色になります Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub

  • エクセル マクロ修正

    シート1&#65374;5まであります。別に情報シートを作成しています それぞれ同じ原本から作成しています 全部のシートにA1&#65374;A10のセルに日付、B1&#65374;B10のセルに文字など入力がするところがあります 入力はA1から順番に入れていきます 例えば 保存ボタンを作成しておく シート1のA1に日付、B1に”文字”を入力し、保存ボタンをおす 情報シートに日付と内容が一致する情報がなければ、 情報シートのA列にシート名、B列に日付、C列に入力した内容が 空白のところに出力される ボタンのマクロがCommandButton1_Clickとしたら Private Sub CommandButton1_Click() 検索 End Sub 標準モジュールに Sub 検索() Dim c As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1LastRow As Long Dim ws2LastRow As Long Set ws1 = Sheets("情報シート") Set ws2 = ActiveSheet If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical Exit Sub End If If ws1.Range("A1").Value = "" Then ws1LastRow = 0 Else ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row End If ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp)) If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then MsgBox "既にデータが存在します", vbInformation Exit Sub End If End If Next ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value MsgBox "データを追加しました", vbInformation Set ws1 = Nothing Set ws2 = Nothing End Sub これを教えて頂き作っていたのですが 別のシートを作成しこのプログラムを応用していたのですが うまく起動しないため再度投稿しました 今度のやつは固定でやろうと思っていていじったのですが 別の欄の文字が表示してしまった 結合セルB2:C4に日付を入れる 結合セルL2:L30に内容を入れるようにしたいのですが ここだけのセルを参照するようにしたいのです。 どうすればいいでしょうか? 試したことAをB2にかえ、BをL2にしたら変なことになりました・・・

  • エクセルの簡単なマクロ機能を追加したいのです

    既存のエクセルマクロ(Sub チェック()以下です)に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です:  Sheet2のC列に 0  があれば  Sheet1のB列に 愛 と([太字]でセルの背景色を[灰色25%]にして)入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub

  • エクセルマクロで教えてください

    Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行 対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。

  • より単純なマクロにしたいのですが・・・

    Dim Ws1 As Worksheet, Ws2 As Worksheet Dim i As Long Set Ws1 = Worksheets("名簿") Set Ws2 = Worksheets("表面") For i = Ws1.Range("B2").Value To Ws1.Range("B4").Value Ws2.Range("HA2").Value = i Ws2.Select If Range("HD2").Value = 1 Then Range("HG2").Select ActiveCell.FormulaR1C1 = "1" Range("HD2").Value = 2 Then Range("HG2").Select ActiveCell.FormulaR1C1 = "1" Sheets(Array("表面", "裏面")).Select ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)" Range("HG2").Select ActiveCell.FormulaR1C1 = "2" ElseIf Range("HD2").Value = 3 Then Range("HG2").Select ActiveCell.FormulaR1C1 = "1" Sheets(Array("表面", "裏面")).Select ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)" Range("HG2").Select ActiveCell.FormulaR1C1 = "2" Sheets(Array("表面, "裏面")).Select ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)" Range("HG2").Select ActiveCell.FormulaR1C1 = "3" End If Sheets(Array("表面", "裏面")).Select ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)" Next Sheets("名簿").Select Range("F1").Select Range("C5").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select End Sub "表面"シートのHA2に任意の印刷No.が入っていき、"表面"シートのHD2にそれぞれ任意の印刷No.に応じて1&#65374;3の数字が振られているためその割り振り数字が入っていきます。HD2の数字が1の時は、HG2セルに1の数字が順に入り印刷(表面と裏面は印刷設定で両面になっています)し、HD2の数字が2の時は、HGセルに1の数字が入り印刷、次にHGセルに2の数字が入り印刷。HD2の数字が3の時は、HGセルに1の数字が入り印刷、次にHGセルに2の数字が入り印刷、次にHGセルに3の数字は入り印刷というマクロになっています。実際に動かしてみると 非常に重いため、よりスマートにできるようなコードを考えているのですがこれが私の限界です。どこでも良いので、簡潔にできる所があればアドバイスをいただけると幸いです。