Excel VBAで売上データを支店別にコピーする方法
- ExcelのVBAを使って売上データを支店別にコピーする方法を教えてください。
- 最近ExcelのVBAを勉強し始めたのですが、売上の一覧シートから支店別にデータをコピーして別のシートに貼り付ける作業を効率化したいです。
- 支店が増えるたびにコピー範囲を増やすのが手間なので、支店数をフォームで入力して自動的にコピーしてくれるマクロを作りたいです。しかし、うまく動かすことができません。
- ベストアンサー
formに入力した値からコピーしたんですが・・・
最近ExelのＶＢＡを覚え始めました。 困っていることがあります。売上の一覧シートからから提出用の シートに項目別に貼り付けの作業をEXCELで行っているのですが。 以前はマクロで記録してまったく同じ作業を繰り返していたのですが。 最近支店が毎月のように増えるのでそのたびに Range("E2:E6").Select←「１つ支店が増えるとの範囲を＜Ｅ６＞を＜Ｅ７＞に変更する」 Application.CutCopyMode = False Selection.Copy Range("I2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False と支店が増えるたびにコピー範囲を1つ増やしていました。しかしコピーする項目分（売上・平均.....etc）だけ編集で直すのも大変なので、なんとかフォームで支店数を入力するとその値に対してコピーを行ってくれるものを作りたいのですが・・・・・。 挑戦しましたが・・・どうしてもとんでもない値をコピーしてくるか、エラーが表示されてしまいます。 よろしくお願いします。。
- masa2000z28
- お礼率79% (95/120)
- Visual Basic
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
これでどうでしょう まずフォームで支店の数を入力します これをindexとします あとはセレクトの部分を下記内容にすれば出来ないでしょうか A ="E2:E" & index Range(A).Select
関連するQ&A
- マクロについて教えてください
マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの（氏名や項目は違いますが）を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1（A9) → sheet2(C2) sheet1（E9) → sheet2(C5) sheet1（I9) → sheet2(C8) ●項目1 sheet1（A8) → sheet2(E3) sheet1（E8) → sheet2(E6) sheet1（I8) → sheet2(E9) ●項目2 sheet1（A18～D18の結合セル) → sheet2(E2) sheet1（E18～H18の結合セル) → sheet2(E5) sheet1（I18～L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか？？ ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub
- ベストアンサー
- その他（プログラミング・開発）
- エクセルマクロ 繰り返して、別のシートへコピーしたい
エクセルマクロ 繰り返して、別のシートへコピーしたい マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、 どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 1行目から１０行目まで繰り返したくて、 1行目から2行目のセルの移動の差は１０行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False
- ベストアンサー
- オフィス系ソフト
- シート1のC列の最終行をコピーして同じ行に値貼り付けしたい
シート1のC列の最終行を取得して その行を丸々値貼り付けするマクロを作りたいと思います。 シート3のB18の値をシート1のC列の最終行の1つ下のセルに値貼り付け すると、その行のA、B列に日付が入力される関数が入っています。（下まで） 関数が入ったままだと、うまくいかない時があるので最終行をコピーして値貼り付けしたいのですが、マクロの作り方を教えてください。 シート1の最終行に貼り付け Sheets("Sheet3").Select Range("B18").Select Selection.Copy Sheets("Sheet1").Select Range("C65536").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub 最終行をコピーして値貼り付け Dim 最終行 As Integer 最終行 = Range("C65536").End(xlUp).Row Range("A6:C" & 最終行).Select Selection.Copy Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub このマクロだと、A6からC列の最終行まで全てコピーされてしまうので、C列の最終行のAからC列まで1行だけコピーできないでしょうか？
- 締切済み
- Visual Basic
- Excel 繰り返しマクロ
下記のようなマクロを使ってn個あるシートの内容を「集計」シートにコピーさせるようにしました。 (自動マクロとの組合せなので、スマートではないかもしれませんが) でも、これだと「集計」シートもコピー作業を行ってしまうので、 「集計」シートはコピー作業をしないように除外したいのですが、どうしたら良いのでしょう? 実際にはシート数は30程度、コピペ項目は1シートあたり30項目程度あります。 よろしくお願いします。 ------------------------- Sub テスト2() ' For i = 1 To Worksheets.Count '案件番号等コピー ' Sheets(i).Select Range("D3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '案件名 Sheets(i).Select Range("F3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '国名 Sheets(i).Select Range("E3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '選択セルの解放 Application.CutCopyMode = False '行挿入 ' Sheets("集計").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Next i End Sub
- ベストアンサー
- その他(業務ソフトウェア)
- Visual Basicのエラー
以下のプログラムで Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False の部分で「コピー領域と貼り付け領域の形が違うため、情報を貼り付けることができません。」というエラーが出てしまいます。 因みに、コピー元もコピー先も結合セルはありません。 どのように修正すればよいのでしょうか？ -------------------------------------------------------------------------------- Retu = Array(, 2, 17, 10, 9, 6, 7, 8) For N = 1 To 7 'Array関数Indexは０から始まるため、最後は抽出列数より１少ないものになる。 計上Sheet1.Activate 計上Sheet1.Range(Cells(5, Retu(N)), Cells(Sheet1件数MaxRow, Retu(N))).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 計上Sheet3.Activate 計上Sheet3.Cells(25, N).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False
- 締切済み
- Visual Basic
- sheetの末尾にコピーする方法
エクセルＶＢＡで売上帳を作っています。 ひとつのbookで、売上帳sheetと入力用sheetを作っています。 入力用sheetから売上帳sheetへコピーする際に、売上帳sheetが３行目で終わっていたら、次は４行目から、というふうにしたいのですが、できません。 下のコードで実行すると、売上帳sheetの表の最終行からの貼付けになってしまいます。 Sub 売上() 行番号 = Range("最終行").Row - 2 '入力用sheetの最終行の2行上の行番号取得し「行番号」に代入 セル = "F" & 行番号 Range("B8:" & セル).Select Selection.Copy '入力用sheetの対象部分をコピー Worksheets("売上帳").Activate '売上帳シートをアクティブにする 行 = Range("G4").CurrentRegion.Rows.Count + 1 'アクティブセル領域の行数 + 1 Range("G" & 行).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '値の貼り付け End Sub どなたか教えてください。 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- ＥＸＣＥＬの自動記録の修正の件
いつもお世話になっております。 こんな質問しました。 http://okwave.jp/qa3973267.html http://okwave.jp/qa3973335.html なんとか、自動記録とＯＫｗｅｂの受け売りで、 やってみました。 でも、もう限界です。 教えて下さい。 【困っていること】 １．保管するファイル名を固定でなく、 見積書.XLSのH13（固定）の値で、 ファイル名を付けて保存したい。 ２．台帳.XLSのT2:AG2のコピー先で、 全てが選択されている状態のため、 リンクが全項目になっている。 先頭の項目だけにしたい。T2のコピー先のみ。 ３．リンクを固定でなくて、 ファイル名、表示名をT2（固定）の値、 もしくはコピー先（可変）の値でしたい。 今は、見積書.XLSとSEC01-20080001となっているのを、 可変に、例、SEC01-20080100.XLSとSEC01-20080100にしたい。 現在のコード（一部）は以下です。 Range("A1").Select ChDir "H:\2008\見積" ActiveWorkbook.SaveAs Filename:= _ "H:\2008\見積\見積書.xls", FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False Windows("台帳.xls").Activate Range("T4").Select Selection.Copy Range("T2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("S3").Select Application.CutCopyMode = False Selection.Copy Range("S1").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("T2:AG2").Select Application.CutCopyMode = False Selection.Copy Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="見積書.xls", _ TextToDisplay:="SEC01-20080001" Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Offset(1).Select ActiveWorkbook.Save 宜しくお願い致します。
- ベストアンサー
- Visual Basic
- 指定セルをコピー
A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか) 環境はoffice2013です。 Range("A2:A6").Select Selection.Copy Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D2:D6").Select Selection.Copy Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False
- ベストアンサー
- Excel（エクセル）
- マクロの記録を書きかえる
下記の構文を可能な限り短くして書きたいのですが、 どのように省略出来るのかがわかりません。 ＜シート1のB列のデータの入力されているセルまでコピーし、シート2のA2から値で貼付ける＞ Range(\"B2\").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets(\"Sheet1\").Select Range(\"A2\").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ご指導宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 抽出してコピペ 検索すべき文字が存在しない場合は？
エクセルのマクロを使って、売上帳を作成しています。 下のようなコードで、F2に顧客番号を入れると、売上帳シート内から選んだ顧客のみの売上明細が個別売上帳シートに移るように作っています。 そこで問題なのですが、売上帳シート内に存在しない顧客番号（取引がなかった顧客）を抽出しようとすると、全明細がそっくり抽出されてしまいます。 私としては、その場合は抽出すべきものがないとして、個別売上帳シートは空欄にしてしまいたいのですが、どうすればよいでしょう？ 教えてください。 Sub 顧客抽出コピペ() Sheets("売上帳").Select Range("B6").AutoFilter Field:=2, Criteria1:=Range("F2").Value '2つ目のフィルターに検索文字 Range("B5:B2005").Select Selection.Copy Sheets("個別売上帳").Select Range("B5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("売上帳").Select Range("E5:J2005").Select Selection.Copy Sheets("個別売上帳").Select Range("C5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End Sub
- ベストアンサー
- オフィス系ソフト
お礼
早速の回答ありがとうございます。 おかげで出来ました。 「A ="E2:E" & index 」を「A ="E2:E" & index + 1」に したところ、目的の範囲をコピーしてくれました。 助かりました。ありがとうございます。 また何かありましたら。よろしくお願いします。