VBAで指定フォルダに複数のセル内容を保存する方法

このQ&Aのポイント
  • VBAを使用して、指定のフォルダに複数のセルの内容を保存する方法について教えてください。
  • 保存するファイルの形式を変えるとうまくいかない場合があり、試行錯誤しています。
  • pdfでの保存コードがxlmsに変更してもpdfファイルで保存される理由が分かりません。
回答を見る
  • ベストアンサー

VBA 指定フォルダに複数のセル内容で保存

こんにちわ。 いつもお世話になっております。 さて、毎度VBAでお世話になっており、表題については指定のシートのみxlsx、pdfファイルで保存するような場合のコードは都度教えていただいて都度うまく行っていたのですが、フォルダやファイルの種類を変えるとうまく行かない場合が多く、試行錯誤で何とかしていたので須が、今回どうしてもあれとこれとを組み合わせてもうまく行かず。 今回の目的で使えそうなpdfでの保存コードは何故かコード中の「pdf」を「xlms」に変更してもpdfファイルで保存されてしまうのは理解できず。 そこでNETで調べたら当方にも分かり易い汎用の下記のサンプルコードがあったのですが > 'ドライブ等の名前を変数に > hozonPath = "K:\" のドライブの書式 ”K:\” が良くわかりません。 具体的に "\\Srv01\業務g\応援チーム\MyPicture" このフォルダに保存したいのですが、どう記載するのか教えてください。 ファイル名にしたいセルは単にA1、A2というように単にセルの列行の記載すればいいのですよね? あまりに初歩的過ぎて質問の意味が分かりにくいでしょうか? Sub hozon() Dim wb As Workbook 'ワークブック Dim ws As Worksheet 'ワークシート Dim hozonPath As String 'ドライブ等のパス用 Dim FolName As String 'A1セル用のフォルダ名用 Dim FilName As String 'A2セル用のファイル名用 '自ワークブック Set wb = ThisWorkbook 'アクティブシート Set ws = ActiveSheet 'ドライブ等の名前を変数に hozonPath = "K:\" 'A1セルの値を変数に FolName = ws.Range("A1").Value 'A2セルの値を変数に FilName = ws.Range("A2").Value wb.SaveAs Filename:=hozonPath & FolName & "\" & FilName End Sub

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

  • ベストアンサー
  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.8

>使用するファイル(帳票)の保存場所はサーバ(の顧客別,品種別のフォルダ)にあって、 >これを台帳にして 保存先のフォルダーは、この台帳ごとに固定的に決まっているので ソースコード上の先頭行付近で宣言しておきたい。 保存先のファイル名は、 保存するときに選択しているシートのA1セルの中身とA2セルの中身を結合した名前にしたい。 また、結合するときに、全角スペースを挟みたい。 都合、 >A1には ABC123 と入れてみて、A2にXYZ987として試してみました。 という状態で 保存先を \\Srv01\業務g\応援チーム\見積書\ABC123 XYZ987.xlsm としたいのであれば Sub hozon()      Const hozonPath = "\\Srv01\業務g\応援チーム\見積書\"   Dim wb As Workbook   'ワークブック   Dim ws As Worksheet   'ワークシート   '自ワークブック   Set wb = ThisWorkbook   'アクティブシート   Set ws = ActiveSheet   wb.SaveAs Filename:=hozonPath & _    WS.range("A1").value & " " & _    WS.range("A2").value & ".xlsm" End Sub となりましょう。

akira0723
質問者

お礼

恐らく訳の分からん質問に関わってしまった、と思いながらも見放さずに根気よくご対応くださったことに深く、深く感謝です。 本当~にすみませんでした。

akira0723
質問者

補足

うれしさのあまり、お礼枠にいっぱい書いてしまって、迷惑に気付き、投稿する最後に削除したら「お礼の言葉」が抜けていました。 この度は本当にありがとうございました。 これから汎用に使うことになります。 たまに新しいパスとファイル名に変更する時には毎回試行錯誤していましたのでこれで解決できます。 再度、お手数をおかけし申し訳ありませんでした。

その他の回答 (7)

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.7

>\\Srv01\業務g\応援チーム\XXXXX\山 海 森 谷.xlsm となることを期待しています。 上記 xxxxx は、何処に埋まっている文字列でしょうか?

akira0723
質問者

補足

最初の質問の例示コードが違っていたために混乱を極めてしまいました。(質問に挙げた例と当方のやりたいことが違ってしまっていたようです) 本当に申し訳ありません。(おそらく当方のやりたいことは回答者様には非常に簡単だと推測するのですが質問が的外れのために膨大な手間をかけさせていると思います) がこの件は簡単に諦められないので、何とか宜しくお願いします。 フォルダもファイル名もプログラムの冒頭で宣言するような表記にしたいのです。 (そろそろ引退の準備を始めていますので) イメージとしては、グラフ化する時に教えていただいた下記のような感じで、フォルダもファイル名もコードの冒頭で指定できれば非常に使いやすいと思ったのでですが、これまた今回のケースでは当てはまらないのでしょうか? フォルダは、フォルダをシフト+右クリックでコピーしたパスをC&Pで転記します。 もしこれも見当違いなら無視してください。 Const MaxRows = 30 'データ範囲に指定する最大行数 Const ColNum1 = 6 '1つ目データ格納列 Const ColNum2 = 8 '2つ目データ格納列 Const SRowNum = 17 'データ開始行番号 Const KoumokuRow = 5 '項目名格納行番号 Const ShNameGD = "入力表" 'データ格納シート名 Const ShNameGr = "成績表" 'グラフ描写シート名

  • SI299792
  • ベストアンサー率48% (715/1480)
回答No.6

>帳票なのでA1にパスを入れることはできません 上げたプログラムはA1にパスを入れていたのでこうするのかと思いました。 もともと入っていたフォルダと同じフォルダに出力したいなら、 ThisWorkbook.SaveAs ThisWorkbook & "\" & [A2], xlOpenXMLWorkbook にします。 そうでなく、ワークブック別にフォルダを指定したい場合、 1行目を印刷対象外にする。又は非表示にする。 Sheet2を作って、A1にフォルダを入れ、 ThisWorkbook.SaveAs [Sheet2!A1] & "\" & [A2], xlOpenXMLWorkbook にする。という方法があります。 プログラム中に、   Const Path = "\\Srv01\業務g\応援チーム\MyPicture" を入れる方法もありますが、ワークブックにより保存先が違うのなら、お勧めしません。

akira0723
質問者

お礼

<至急>補足で >うまき行きました! と報告しましたが、保存されたファイルは、xlsxでした。 マクロが使えるxlsm形式で保存したいのですが、拡張子をどこで変えるのかわかりません。 全く何が何やら状態で申し訳なく。 Sub Macro1() ' Application.DisplayAlerts = False ThisWorkbook.SaveAs [保存フォルダ!A1] & "\" & [A2] & [C1], xlOpenXMLWorkbook Application.DisplayAlerts = True End Sub ~

akira0723
質問者

補足

本当に何度もお手数をおかけしています。 ご回答のコードを下記にして試してみてうまく行きました! また、フォルダはPCのドライブでもサーバでも問題無く行行きました。何故この場合は区別しなくて良いのか???ですが。 Sub Macro1() ' Application.DisplayAlerts = False ThisWorkbook.SaveAs [保存フォルダ!A1] & "\" & [A2] & [C1], xlOpenXMLWorkbook Application.DisplayAlerts = True End Sub ~~~~~~~~~~~~~~~~~~~~~~~~ 但し、出来ればフォルダの指定はシートの挿入ではなくコード中で指定したいのです。 しかも、行の途中(一部)ではなく、コードの冒頭に。 下記はグラフを自動作成する時の例ですが、 (質問では変に似た例を挙げたので混乱させましたのであえて全く違う例にしましたが、これまた混乱するようなら無視してください) >Const MaxRows = 30 'データ範囲に指定する最大行数 > Const ColNum1 = 6 '1つ目データ格納列 >Const ColNum2 = 8 '2つ目データ格納列 > Const SRowNum = 17 'データ開始行番号 >Const KoumokuRow = 5 '項目名格納行番号 > Const ShNameGD = "入力表" 'データ格納シート名 >Const ShNameGr = "成績表" 'グラフ描写シート名 のように、 Const Path = "\\Srv01\業務g\応援チーム\MyPicture" ’フォルダのパス ConstFileName=”A1” ’ファイル名にしたい内容1 ConstFileName=”C3” ’ファイル名にしたい内容2 ConstFileName=”H5” ’ファイル名にしたい内容2 みたいな書式にしたいのが最初の希望だったのです。 贅沢なようですが、そろそろ引退なので手順書に指定しやすく、誰でも簡単に指定できるようにしたいのです。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.5

もう一度聞きます。 保存元のブック(操作中)のブックは自身のPCにあって、 これをファイルサーバー上に保存したいということでいいですね? それとも、保存元のブック(操作中)のブックも \\Srv01\業務g\応援チーム\MyPictureフォルダーの中にあるんですか? 保存直前に選択しているシートに添付画像1枚目のように埋まっているとき \\Srv01\業務g\応援チーム\MyPicture\山 海 森 谷.xlsm '(1) となることを期待していますか?それとも、 \\Srv01\業務g\応援チーム\MyPicture\山 海 森 谷.xlsx '(2) となることを期待していますか? 保存直前に選択しているシートに添付画像2枚目のように埋まっているとき \\Srv01\業務g\応援チーム\MyPicture\山 森 谷.xlsm '(1) となることを期待していますか?それとも、 \\Srv01\業務g\応援チーム\MyPicture\山 森 谷.xlsx '(2) となることを期待していますか? (2)の場合、保存先にマクロは含まれません

akira0723
質問者

お礼

操作中のブックは、\\Srv01\業務g\応援チーム\MyPicture でした。 ますます混乱! >それとも、保存元のブック(操作中)のブックも \\Srv01\業務g\応援チーム\MyPictureフォルダーの中にあるんですか? ではなく、\\Srv01\業務g\応援チーム\ の別のフォルダです。

akira0723
質問者

補足

最初のは会社のサーバで質問し、その後自宅のPCのフォルダで質問したため混乱させてしまい申し訳ありません。 ~~~~~~~~~~~~~~~~~~~~~~~~ 保存元のブック(操作中)はサーバの\\Srv01\業務g\応援チーム\MyPictureにあります。 これをサーバ内の\\Srv01\業務g\応援チーム内の既にあるフォルダを指定して、マクロ有効で保存したい、です。 ~~~~~~~~~~~~~~~~~~~~~~~~ >保存元のブック(操作中)のブックは自身のPCに ではなく、サーバ内の「\\Srv01\業務g\応援チーム\MyPicture」です >これをファイルサーバー上に保存したいということでいいですね? サーバ内の原紙とは別のフォルダに保存したい、です >それとも、保存元のブック(操作中)のブックも \\Srv01\業務g\応援チーム\MyPictureフォルダーの中にあるんですか? ではなく、\\Srv01\業務g\応援チーム\ の別のフォルダです。 >保存直前に選択しているシートに添付画像1枚目のように埋まっているとき \\Srv01\業務g\応援チーム\MyPicture\山 海 森 谷.xlsm '(1) ではなく、\\Srv01\業務g\応援チーム\XXXXX\山 海 森 谷.xlsm となることを期待しています。 本当に訳が分からなくて済みません。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.4

保存元のブック(操作中)のブックは自身のPCにあって、 これをファイルサーバー上に保存したいということでいいですね? >A1には ABC123 と入れてみて、A2にXYZ987として試してみました。 この時に、 \\Srv01\業務g\応援チーム\MyPicture\ABC123\XYZ987.xlsm '(1) \\Srv01\業務g\応援チーム\MyPicture\ABC123XYZ987.xlsm '(2) \\Srv01\業務g\応援チーム\MyPicture\ABC123\XYZ987.xlsx '(3) \\Srv01\業務g\応援チーム\MyPicture\ABC123XYZ987.xlsx '(4) これのどれにしたいですか? (1)、(3)の場合であれば 予めABC123というフォルダーを用意するか、あるいは、 無い場合には、マクロで動的に作成する必要があります。 (3)、(4)であれば、保存先ブックにはマクロが無くなります。 どれにするかでコードの書き方が変わってきます。

akira0723
質問者

お礼

先ほどの補足でご質問に答えていませんでした。 やりたいことは2です。 但し、操作するブックもサーバのフォルダです。 サーバの「各種原紙」のフォルダ中の顧客別のファイルに入力して顧客名のサーバのフォルダに複数のセル内容で保存したい。 でした。 いつもながら知識と文書力のなさでお手数をおかけしますが、これ(汎用性のあるVBA)は何とかしたい課題なので今少しお知恵をお貸しください。

akira0723
質問者

補足

全くお恥ずかしい話ですが、サーバはドライブの1つだという認識でした。 ドライブは¥が1つでサーバは2つ付けることで区別されるのであろう、という認識でした。 そこでやっと自分の要求が分りました。 1.使用するファイル(帳票)の保存場所はサーバ(の顧客別,品種別のフォルダ)にあって、これを台帳にして、顧客別や製品別の帳票を作成します。 2.できた顧客,製品別のファイルをサーバの指定したフォルダにマクロ有効で保存したい。 3. 保存する時のファイル名は複数のセル内容をつなげてファイル名にしたい。(出来れば空白で区切って) 4.できれば式中の一部を変更するのではなく、コードの冒頭で、 サーバのフォルダパス:xxxx??? ファイル名にしたいセル:A1 ファイル名にしたいセル:B4 ファイル名にしたいセル:H5 ファイル名にしたいセル:F6 というように最初に場所を宣言する形で指定できるようにしたい。 同様の帳票は各種あるので上記が出来れば非常に汎用性が出ると思い質問させてもらいました。 NETでは同様のコードが一杯あるのですが使いこなせませんでした。(確かにドライブとサーバの区別が付かない人は対象外だと思います) 今少しお付き合いください。

  • SI299792
  • ベストアンサー率48% (715/1480)
回答No.3

A1: \\Srv01\業務g\応援チーム\MyPicture A2: ファイル名 が入っているのでしょうか。 という事は、サーバですか。 サーバにドライブはありません、このままでは、フォルダは K:\\\Srv01\業務g\応援チーム\MyPicture となり、エラーになります。 hozonPath & は外して下さい。 フォルダを作る必要はないのですね。 私は長いプログラムが嫌いなので、単純に ' Sub Macro1() '   Application.DisplayAlerts = False   ThisWorkbook.SaveAs [A1] & "\" & [A2], xlOpenXMLWorkbook   Application.DisplayAlerts = True End Sub にします。 サーバでない場合、 A1: K:\Srv01\業務g\応援チーム\MyPicture にすればよく、どちらも対応できます。 なお、既にファイルがある場合、メッセージを表示せず、いきなり上書きされます。メッセージが必要なら、補足に書いて下さい。

akira0723
質問者

補足

朝一で試してみてうまく行きました。 但し、今回はファイルは帳票なのでA1にパスを入れることはできません。 ファイルはサーバ上のフォルダにあって、保存は別の指定したフォルダに入れたいのですが、製品別に指定したフォルダに保存されるようにしたいのです。 具体的には顧客ごとの原紙に入力してそれを顧客名のフォルダをコード中で指定して、指定した複数のセルの内容で、マクロ有効なファイルで保存したいのです。 当方フォルダとドライブの違いが分かっていないことに今回気づいたレベルですので大目に見てやってください。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.2

A1セル、A2セルに埋まっている値を教えてください。 また、エラーメッセージを教えてください。 提示のコードは、 \\Srv01\業務g\応援チーム\MyPicture の下階層に、 A1セルに埋まっている中身と同名のフォルダーが すでに作成したある前提です。 このフォルダーがもしなかった場合には、 VBAでこのフォルダーの作成もすることを期待していますか?

akira0723
質問者

お礼

先ほどのお礼に対する訂正です。 シート上(A1)にフォルダのパスは入れられません。 サーバのフォルダのパスはコードの最初で宣言して、複数のセル内容をファイル名にしたい、です。 ウッカリA1にパスが入っている前提の質問に2と回答してしまいました。

akira0723
質問者

補足

早々のご回答ありがとうございます。 当方やはり本当に基本的なことが抜けているようです。 自宅なのでダミーファイル(book1)で試してみているのですが、 目的のフォルダのパスは "C:\Users\tsukasa akira\Desktop\見積書" で、この見積書の中にABC123というフォルダを作っておきました。 A1には ABC123 と入れてみて、A2にXYZ987として試してみました。 結果は、「マクロ無しのブックに保存できません」と見慣れたMsgがでて、これに「はい」でも「いいえ」でも、「1004:アプリケーション定義またはオブジェクトの定義エラーです」と出ます。 先ほどまではA1、A2共にファイル名のつもりで試行錯誤しており、その時には、「パス、またはファイル名が違っています」みたいなMsgが出たこともありました。 このコードはA1に保存するフォルダ名を入れるようになっているのですね? 当方の希望は、「パスのコピー」で取ったフォルダ 「 "C:\Users\tsukasa akira\Desktop\見積書"」 の見積書のフォルダに、A1、B2、H3というようにファイル名を付記して保存したいのです。 やりたいことが分かっていただけるでしょうか? コードがすでにあるのに何故できないかが理解されるか心配です。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.1

私だったら以下にします。 Sub hozon()      Const hozonPath = "\\Srv01\業務g\応援チーム\MyPicture\"   Dim wb As Workbook   'ワークブック   Dim ws As Worksheet   'ワークシート   'Dim hozonPath As String 'ドライブ等のパス用   Dim FolName As String  'A1セル用のフォルダ名用   Dim FilName As String  'A2セル用のファイル名用   '自ワークブック   Set wb = ThisWorkbook   'アクティブシート   Set ws = ActiveSheet   'ドライブ等の名前を変数に   'hozonPath = "K:\"   'A1セルの値を変数に   FolName = ws.Range("A1").Value   'A2セルの値を変数に   FilName = ws.Range("A2").Value   wb.SaveAs Filename:=hozonPath & FolName & "\" & FilName End Sub

akira0723
質問者

補足

毎度お世話になります。 いくつかの保存コードを試行錯誤したのですが、いつも最後の行 ご回答の場合も >wb.SaveAs Filename:=hozonPath & FolName & "\" & FilName で止まります。 最後の行も取っ変えひっかえしてみたのですがダメでした。

関連するQ&A

  • VBA 名前を付けて保存の方法について

    VBAのコードにて名前を付けて保存のやり方ができません。 現在開いているファイルを 名前を付けて保存したいのですが ファイルの指定方法が間違っているのか保存できません。 やりたいこと 現在開いているファイル内のシート(設定画面)の A1セルとA2セルの文字を "G:¥●エクセル¥ソフト¥計画"のドライブにて 保存する(A1セルとA2のセルの文字をくっつけて名前を付けて保存したい) 例:元のbook1のファイル名をA1セルとA2セルの文字をくっつけた   名前にしてから保存したい。 保存先のドライブの指定方法が分からなかったため マクロの記録にてそのドライブへ名前を付けて保存してみて ドライブの名前の指定をしました。(この方法も間違っていますか?) コードを下記に記載しています。 すいませんがうまく動くコードを記載してもらえると 助かります。 回答よろしくお願いします。 Sub macro1() Dim wb As Workbook Dim ws As Worksheet Dim hozonPath As String Dim FolName As String Dim FilName As String Set wb = ThisWorkbook Set ws = Worksheets("設定画面") hozonPath = "G:¥●エクセル¥ソフト¥計画" FolName = ws.Range("A1").Value FilName = ws.Range("A2").Value wb.SaveAs fileName:=hozonPath & FolName & "¥" & FilName End Sub

  • 指定したセルでファイル名を保存するマクロについて

    マクロ初心者です。 A1セルの文字をファイル名にして保存する方法を知りましたが、A1セルとB1セルの文字をファイル名にして保存したい場合、どのようにすれば良いか分かりません。 A1セルに企業コード、B1セルに企業名です。 ファイル名を「請求書(13579いろは株式会社様)」としたいのです。 実際のマクロを一部抜粋しますが、下記の場合はファイル名は 「請求書(13579様).xls」となります。 Dim WS As Worksheet Dim fname As String fname = "C:\保存先\" & ("請求書(") & WS.Range("a1").Value & ("様)") & ".xls" どなたか教えて下さい。 どうぞよろしくお願い致します。

  • VBAにて計算式をセルへ代入できなくて困っています

    計算式を変数QRdataへ代入し その変数から指定のセルへ入力するとき、実行時エラー1004となってしまい マクロを実行できずに困っています。 Cells(3, 6).ValueもRange("F3").Fourmulaと変えたりしたのですが解決方法が解らなく どうか御教授下さい。 Dim コードナンバー As String Dim 品名1行 As String Dim QRdata As String QRdata = "=("& Chr(34) & コードナンバー & 品名1行 & Chr(34) & ",1)" Cells(3, 6).Value = QRdata  ←ここでエラーとなってしまいます。

  • AccessからExcelへの出力

    質問します。 AccessからExcelへ、VBAで指定セルに指定データを落としこむコーディングをしています。 とあるサイトを参考に、下記のコードを組みましたが、実行すると砂時計のまま動かなくなってしまいます。 何が悪いのでしょうか? SQLでしょうか? 時間がなくて困っています。 何卒よろしくお願いします。(><) Option Compare Database Private Sub output() On Error Resume Next Dim app As Object Set app = CreateObject("Excel.Application") Dim oRs As Recordset Dim strSQL As String Dim Wb As Excel.Workbook Dim Ws As Excel.Worksheet Dim FileName As String Dim Worksheet As String Dim X As Long Dim Y As Long FileName = "C:\nouhinnsyo.xls" 'エクセルのファイル名 Worksheet = "納品書" 'ワークシート名 Set Wb = app.Workbooks.Open(FileName) 'ワークブックの指定 Set Ws = Wb.Worksheets(1) 'ワークシートの指定 strSQL = "SELECT 日付,伝票番号,品番,商品名,出庫数,摘要" strSQL = strSQL & vbCrLf & "FROM 棚卸マスタ" '出力用レコードセット Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset) Y = 12 X = 0 Do Until oRs.EOF Ws.Cells(Y, X + 1) = oRs("日付") Ws.Cells(Y, X + 2) = oRs("品番") Ws.Cells(Y, X + 3) = oRs("商品名") Ws.Cells(Y, X + 4) = oRs("出庫数") Ws.Cells(Y, X + 9) = oRs("摘要") oRs.MoveNext Y = Y + 1 Loop oRs.Close Wb.SaveAs FileName 'ファイルの保存 Wb.Close 'ワークブックのクローズ Ex.Quit 'エクセルセッションをクローズする。 Set Ws = Nothing '変数の初期化 Set Wb = Nothing '変数の初期化 Set Ex = Nothing '変数の初期化 Set oRs = Nothing End Sub

  • 【VBA】複数のブックを1つのシートにまとめる

    あるフォルダ内に複数のブックが入っており、新しいブックに1シートでまとめようとしております。 フィルターを使用すればよいのかもしれませんが、マクロを使用したいです。 (1)全て同じフォーマットである (2)全てA17から数値が入力されているので、16行目まではフォーマットを残し、A17行目以降K列までをコピーして結合したい Sub 結合() '結合したいファイルがあるフォルダの場所 cドライブなら "C:\test\" Const Fol As String = "C:\test\" Dim Fn Dim NewFile As Workbook Dim Wb As Workbook Dim Ws1 As Worksheet Dim R As Range Set NewFile = Workbooks.Add Set Ws1 = NewFile.Worksheets(1) Set R = Ws1.Range("A17") Fn = Dir(Fol, vbNormal) Do Until Fn = "" Set Wb = Workbooks.Open(Fol & Fn) 'ワークシート1をコピーする場合は Wb.Worksheets(1) Set Ws1 = Wb.Worksheets(1) 'タイトル行を設定 If ck = False Then For cnt = 1 To 4 Wb.Worksheets(cnt).Range("A1:J16").Copy Destination:=NewFile.Worksheets(cnt).Range("A1") Next cnt ck = True End If For cnt = 1 To 4 Set Ws1 = NewFile.Worksheets(cnt) Set Ws2 = Wb.Worksheets(cnt) R = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1 With Ws2 End With Next 'A17行目からコピーして結合する(→本当はA17行目~K列までを反映したい) Ws2.Range("A17", Ws2.Cells(Rows.Count, 3).End(xlUp)).Resize(, 20).Copy R If R.Offset(1).Value = "" Then Set R = R.Offset(1) Else Set R = R.End(xlDown).Offset(1) End If Wb.Close 'Debug.Print Fn Fn = Dir Loop Set R = Nothing Set Ws1 = Nothing: Set Ws2 = Nothing Set Wb = Nothing: Set NewFile = Nothing End Sub マクロは触ったことない初心者でグーグル検索をしながら作ってみました。 一応実行するとエラーは出ないのですが、結合されたリストが飛び飛びで、理由がわかりません。 どなたかおわかりになりますでしょうか・・・。

  • エクセルのマクロで複数セル指定は?

    以前(7月22日 質問No.936181)の質問でご回答を頂いたマクロなんですが、 Private Sub Worksheet_Change(ByVal Target As Range) Dim MyData As String Dim i As Integer Dim ImaNanji As String Dim SakkiNanji As String Dim ImaNanpun As String Dim SakkiNanpun As String SakkiNanpun = Cells(2, 3).Value ImaNanji = Cells(1, 3).Value ImaNanpun = Mid(ImaNanji, Len(ImaNanji) - 4, 2) If ImaNanpun <> SakkiNanpun Then Application.EnableEvents = False For i = 10 To 2 Step -1 MyData = Cells(i - 1, 2).Value Cells(i, 2).Value = MyData Next i MyData = Cells(1, 1).Value Cells(1, 2).Value = MyData Cells(2, 3).Value = ImaNanpun Application.EnableEvents = True End If End Sub A1のデータをB1からB10に一分おきにつぎつぎに書き込むというものなんですが、ひとつのセルではなく複数のセル(例えばA1からA30の30個のセル)をいっぺんに書き込むようにしたいのですが可能でしょうか? よろしくお願いします。

  • 複数フォルダにある複数ファイルの一括印刷

    下記の通りフォルダの中にある、複数のエクセルファイルを印刷するマクロを使用しています (どこからか、参考にして自分なりに変更したら、出来たのですが・・・) 一つのフォルダに存在する複数フォルダの複数ファイルを、上記同様に印刷する方法は どのようにすればよいのでしょうか?(フォルダは30個位、ファイル1~20個位、増減あり) どなたか、お知恵をお貸しください。お願いいたします。 Sub test() ' ' 印刷マクロ ' Dim fol As String Dim f As String Dim wb As Workbook Dim wscnt As Long Dim i As Long fol = "d:\sampul" f = Dir(fol & "\*.xls") Do While f <> "" Set wb = Workbooks.Open(fol & "\" & f) wscnt = wb.Worksheets.Count For i = 1 To 1 wb.Worksheets(i).PrintOut Next i wb.Close f = Dir() Loop Set wb = Nothing End Sub

  • vba, 複数ブックの同一セルに同一写真を挿入

    エクセルVBAの初心者です。使っているのはExcel2007です。 同じフォルダの中にある連番の複数のエクセルファイルに同じ操作を繰り返すマクロを作っています。まず、複数ブックの同一セルに同じ内容の文字列を挿入することはどこかで見つけました。 Sub 複数Book同一セルに同一文字列入力() Dim fName As Variant Dim i As Long Dim WB As Workbook fName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True) If IsArray(fName) Then For i = LBound(fName) To UBound(fName) Set WB = Workbooks.Open(fName(i)) WB.Worksheets(1).Range("A1").Value = "テスト" WB.Close SaveChanges:=True Next End If End Sub また、選択したセルに同じフォルダの中にある写真を挿入するマクロもどこかで拝見しました。 Sub AddPictureSampLinkPaste() Dim myFileName As String Dim myShape As Shape myFileName = ActiveWorkbook.Path & "\Koala.jpg" '--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納 Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=myFileName, _ LinkToFile:=True, _ SaveWithDocument:=False, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=0, _ Height:=0) '--(2) 挿入した画像に対して元画像と同じ高さ・幅にする With myShape .ScaleHeight 1, msoTrue '数字は写真の高さの倍数 .ScaleWidth 1, msoTrue '数字は写真の幅の倍数 End With End Sub ここまではテストで問題なかったので、この二つのマクロを一つにまとめて、同じフォルダにある連番のエクセルブックの同一セルに同一写真を挿入するマクロを作ろうと下記のようにアレンジしましたが、なぜか写真はマクロを記入したブックのアクティブセルに連番のブックの数だけの写真が重なるように貼り付けられるだけで、標的のブックには写真が挿入できません。 Sub 複数Bookの同じ位置に同一写真挿入() Dim fName As Variant Dim i As Long Dim WB As Workbook Dim myFileName As String Dim myShape As Shape fName = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xlsx", MultiSelect:=True) myFileName = ActiveWorkbook.Path & "\Koala.jpg" If IsArray(fName) Then For i = LBound(fName) To UBound(fName) Set WB = Workbooks.Open(fName(i)) Worksheets("Sheet1").Activate '--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納 Set myShape = ActiveSheet.Shapes.AddPicture( _ Filename:=myFileName, _ LinkToFile:=True, _ SaveWithDocument:=False, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=0, _ Height:=0) '--(2) 挿入した画像に対して元画像と同じ高さ・幅にする With myShape .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue End With WB.Close SaveChanges:=True Next End If End Sub 本当にどこが間違っているか分からず、ここで質問いたします。初心者で分からないところばかりなので、どなたかやさしく教えていただけませんか?よろしくお願いいたします。

  • エクセルVBA フォルダ内のどんなシート名であっても読み込みたい

    フォルダ内の別ブック(D3で指定)の「情報」シートを読み込んで対象年月日に該当するデータを抽出して別ブックに貼り付けるものなんですが、下のコードではSet ws = wb.Worksheets("情報")と、なっていて、限定しているのですが、これをD3のファイルのどんなシート名であっても読み込みたいのですが、どのようにコードにしたらいいでしょうか?D3で指定するブックには必ずひとつのシートしかありません。 よろしくお願いします。 Sub test_1() Dim wb As Workbook Dim ws As Worksheet Dim ms As Worksheet Dim nb As Workbook Dim r As Long Set ms = ThisWorkbook.Worksheets("メニュー") Set wb = Workbooks.Open(ms.Parent.Path & "\" & ms.Range("D3").Value) Set ws = wb.Worksheets("情報") Set nb = Workbooks.Add With ws .Range("Q1").AutoFilter _ Field:=17, _ Criteria1:=">=" & ms.Range("D5").Text, _ Operator:=xlAnd, _ Criteria2:="<=" & ms.Range("F5").Text With .AutoFilter.Range r = .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count If r = 1 Then MsgBox "抽出対象データ無し。" wb.Close False nb.Close False Set wb = Nothing: Set ws = Nothing Set ms = Nothing: Set nb = Nothing Exit Sub End If .Copy End With End With With nb.Worksheets(1) .Paste With .Range("A1:AG1") .Interior.ColorIndex = 6 .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End sub

  • フォルダ内の複数ブックのデータとブック名を転記する

    フォルダの中に複数のExcelファイル(ブック)が入っており、 それら全てのブックデータの転記を一括して行うマクロを現在使用しています。(後述) <現在の利用状況> ・フォルダの中に複数のExcelファイル(ブック)が入っている。ファイルにつきシートは1つ(ひな形は同じ) ・ファイルを確認するまでデータが何行入っているか分からない ・貼り付ける際はシートの上部は意図的に消している <改善希望> ・どのファイルから貼り付けたか分かるように、A列にファイル名を追記したい(どの行にも) ・できれば先頭の3文字のみ VBA勉強中の初心者ですが、なるべく早く実装しないといけないので、困っています。。。。 ご教示頂けます様お願いいたします。 ========================= Sub データ集計() '集計シートを変数に格納 Dim ws As Worksheet Set ws = ActiveSheet '集計シートの最終行を取得 Dim LastRow As Long LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row MsgBox "このブックと同じフォルダにあるブックを全て統合します" 'このブックの保存されているフォルダのパス(番地;ディレクトリ)を変数に取得 Dim thisPath As String thisPath = ThisWorkbook.Path 'ディレクトリにあるExcelのファイル名を取得 Dim fileName As String fileName = Dir(thisPath & "\" & "*.xlsx") Dim i As Long 'ファイル名が無くなるまで繰り返す Do While fileName <> "" '開くワークブックを変数に代入 Dim bufBook As Workbook Set bufBook = Workbooks.Open(thisPath & "\" & fileName) '開いたブックの第1シートの全データ --> 集計シートの最終行 bufBook.Worksheets(1).Range("B14").CurrentRegion.Copy Destination:=ws.Range("B" & LastRow) '最初のループ以外では、タイトル行を削除しておく Dim LastRowSecond As Long LastRowSecond = LastRow + 13 If i > 0 Then ws.Rows(LastRow & ":" & LastRowSecond).Delete End If '開いたブックを閉じる bufBook.Close SaveChanges:=False '集計シートの最終行を再取得しておく LastRow = ws.Cells(Rows.Count, 7).End(xlUp).Row + 1 '次のファイル名が取り出される。 fileName = Dir() i = i + 1 Loop End Sub

専門家に質問してみよう