質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
87.20%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

解決済

ブック名を拡張子なしで別ブックへ転記

mls7ul1007
mls7ul1007

総合スコア5

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

1回答

0評価

0クリップ

476閲覧

投稿2020/05/11 07:36

前提・実現したいこと

簡単なVBAコードしか分からない初心者です。
ブックから別ブックへ更新データを最終行の下へ値を追加する作業をしています。ファイルは3つありまして、1つはマクロブック、残り2つはxlsxです。この中のファイルxlsxのブック名だけを拡張子なしで転記したいと思っています。ブック名の転記は、C:\Users‥などから始まる部分は省きます。
⑴で取得したファイルを拡張子なしでブック名をコピーした後、
⑵で取得したファイルへ転記したいと思っています。
どなたかご教授お願いします。

発生している問題・エラーメッセージ

⑶のコードの場合ですとブック名は、マクロブック名が転記されてしまって、目的の名が転記されない上、拡張子も付いてきてしまいます。

エラーメッセージ

該当のソースコード

ソースコード Sub Book1()   Dim 取得 As Variant Dim 取得2 As Variant       '⑴マクロブックからファイルを取得     取得 = ThisWorkbook.Worksheets("Sheet1").Range("A2").Value                      '⑵マクロブックからファイルを取得      取得2 = ThisWorkbook.Worksheets("Sheet1").Range("A3").Value ' Dim もと As Workbook Dim コピー先 As Workbook          'コピー先及びコピー元のファイルを開く(コピー元は読み取り専用) Set もと = Workbooks.Open(取得, ReadOnly:=True) Set コピー先 = Workbooks.Open(取得2) Dim 先シート As Worksheet Dim 元シート As Worksheet    'コピー先及びコピー元のシートを指定 Set 元シート = もと.Sheets("漢字PC") Set 先シート = コピー先.Sheets("市町村") Dim intRowIdxA As Integer Dim intRowIdxB As Integer   '最終行を取得 intRowIdxA = 先シート.Cells(Rows.Count, 1).End(xlUp).Row intRowIdxB = intRowIdxA + 1 ' 番号を別ブックへ値を転記 先シート.Cells(intRowIdxB, "A") = 元シート.Cells(75, "D").Value ' 日付を別ブックへ値を転記 先シート.Cells(intRowIdxB, "C") = 元シート.Cells(5, "L").Value '⑶ファイル名を別ブックへ転記 Dim sname As String sname = 先シート.Application.ThisWorkbook.Name 先シート.Cells(intRowIdxB, "B").End(xlUp).Offset(1, 0) = sname ' ' オートフィルターで"■"を抽出する 元シート.Range(元シート.Cells(88, "B"), 元シート.Cells(intRowIdxA, "B"). _ End(xlUp)).AutoFilter 1, "■" ' 抽出したデータを別ブックへ値を転記 元シート.Range(元シート.Cells(89, "C"), 元シート.Cells(intRowIdxA, "C") _ .End(xlUp)).Copy 先シート.Cells(intRowIdxB, "D").End(xlUp).Offset(1, 0). _ PasteSpecial xlPasteValues ' 抽出したデータを別ブックへ値を転記 元シート.Range(元シート.Cells(89, "D"), 元シート.Cells(intRowIdxA, "D") _ .End(xlUp)).Copy 先シート.Cells(intRowIdxB, "E").End(xlUp).Offset(1, 0). _ PasteSpecial xlPasteValues ' 抽出したデータを別ブックへ値を転記 元シート.Range(元シート.Cells(89, "E"), 元シート.Cells(intRowIdxA, "E") _ .End(xlUp)).Copy 先シート.Cells(intRowIdxB, "F").End(xlUp).Offset(1, 0). _ PasteSpecial xlPasteValues '識別1または2を判定して別ブックへ転記 If 元シート.Cells(73, "D").Value = "カタカナ" Then 先シート.Cells(intRowIdxB, "G").Value = 1 ElseIf 元シート.Cells(73, "D").Value = "テスト" Then 先シート.Cells(intRowIdxB, "G").Value = 2 ElseIf 元シート.Cells(73, "D").Value = "該当なし" Then 先シート.Cells(intRowIdxB, "G").Value = " " End If End Sub

試したこと

補足情報(FW/ツールのバージョンなど)

Excel2013

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

まだ回答がついていません

会員登録して回答してみよう

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
87.20%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。