[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『データ転記について』（K）
お世話になっております。
現在マクロブックにシート１に所定のフォルダにある転記元エクセルのシート１からあるセルのデータを転記するマクロを作ろうとしているのですが、うまくいきません。お力を貸していただけないでしょうか。
・転記元エクセルにはシート２以降（ファイルによって数は不確定）もあるのですが、それらをシートコピーでマクロブックにコピーし、転記元のファイル名で名前を付けて保存（.xlsx形式）したいです。
・ファイル保存先もファイルダイアログで選びたいです。
現状のコードです。うまくいっておりませんが。。。。
Subデータ転記()
Dim i, s, t, maxR, pno As Long
Dim wb As Workbook
Dim sh1, sh2, sh3 As Worksheet
Dim fpath, fname As String, cFld As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "対象フォルダー選択"
If .Show = True Then
cFld = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
fname = Dir(fpath & "*.xl*", vbNormal) fpath = ThisWorkbook.Path Do Until fname = "" ' Set wb = Workbooks.Open(fpath & fname, UpdateLinks:=0) ' Set sh2 = wb.Worksheets(1)
Set wb = Workbooks.Open(cFld & fname, UpdateLinks:=0)
Set sh1 = ThisWorkbook.Sheets(1)
Set sh2 = wb.Sheets(1)
'転記（例として１セルのみ）
sh1.Range("A6").Value = sh2.Range("B6").Value
ThisWorkbook.SaveAs Filename:=cFld & fname
wb.Close SaveChanges:=False
fname = Dir() Loop
Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True MsgBox "終了しました。" End Sub
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
（マナ） 2020/04/06(月) 18:56
[[20200402200750]] 『フォルダー選択機能』（L）
[[20200403115208]] 『条件の分岐』（K）
（マナ） 2020/04/06(月) 19:01
【cFld】 = .SelectedItems(1) & "\" fname = Dir(【fpath】 & "*.xl*", vbNormal)
（もこな２ ） 2020/04/06(月) 19:59
上手く行ってないと言われても、少し表現が曖昧ですね。
コードを動かしてみれば解るかも知れませんが、
期待する結果に対して、
どうなってしまうかを言ってください。
（まっつわん） 2020/04/07(火) 09:32
Set sh2 = wb.Sheets(1)
とされているので1番目のシートしか対象になってないですね。
いきなり正解を求めるのではなく、一度、やりたいことを疑似コードみたいに書き出してみてはどうでしょうか？
（もこな２ ） 2020/04/07(火) 09:51
というような流れです。
（K） 2020/04/07(火) 10:56
仰ることを整理するとこうなりません？
まくろスタート 「処理フォルダ」を宣言する そのほか必要な変数を宣言する
ユーザーにダイアログボックスで対象の【フォルダ】を選んでもらう 選ばれたフォルダのパスを「処理フォルダ」に格納する
「処理フォルダ」を巡回してExcelブック(*.xlsx)だったら開く
開いたブックの１番目のシートの必要範囲をコピー
自ブックの1番目のシートのA6セルに値のみ貼付
開いたブックの2〜最後のシートまでを巡回して
開いたブックのn番目のシートを、自ブックの最後のシートの後ろにコピー挿入する。
シートの巡回おわり
開いたブックを閉じる
次のブックを探す
未処理のブックが無くなるまで繰り返す
まくろ終わり
（もこな２ ） 2020/04/07(火) 12:57
あとシート巡回終わりの後に名前を付けて保存（上記任意のフォルダに）がいる気がします。
（K） 2020/04/07(火) 13:08
なら必要ですね。
まくろスタート 「処理フォルダ」を宣言する 「出力フォルダ」を宣言する そのほか必要な変数を宣言する
ユーザーにダイアログボックスで対象の【フォルダ】を選んでもらう 選ばれたフォルダのパスを「処理フォルダ」に格納する
ユーザーにダイアログボックスで対象の【フォルダ】を選んでもらう 選ばれたフォルダのパスを「出力フォルダ」に格納する
「処理フォルダ」を巡回してExcelブック(*.xlsx)だったら開く
開いたブックの１番目のシートの必要範囲をコピー
自ブックの1番目のシートのA6セルに値のみ貼付
開いたブックの2〜最後のシートまでを巡回して
開いたブックのn番目のシートを、自ブックの最後のシートの後ろにコピー挿入する。
シートの巡回おわり
開いたブックを閉じる
次のブックを探す
未処理のブックが無くなるまで繰り返す
出力フォルダに保存する
まくろ終わり
（もこな２ ） 2020/04/07(火) 20:24
＞マクロブックにコピーし
いちいち、マクロブックを介する必要があるんですか？
コピー元ブックを丸ごと格納先フォルダにコピーして、 そのブックから不必要なシートとデータをクリアすればいいんじゃないですか？
どんなシートとデータが残るべきなのか分からないので、 どんな手順が効率的なのかは別途考える必要があるとは思いますけど。
（半平太） 2020/04/08(水) 00:35
＞上のカードも自分的には決して適当に切り貼りしたつもりはありません…
ならば、ステップ実行して確かめてみましたか？
cFld = .SelectedItems(1) & "\" fname = Dir(fpath & "*.xl*", vbNormal) fpath = ThisWorkbook.Path
例えば↑では、
(1) データ元があるはずのフォルダパスは「cFld」にあると思われるが、「fpath」で探している (2) 参考にしたものは「*.xl*」ではなく「*.xls?」だったのではないか (3)「fpath」が正しかったとして、Dir関数で使った後に取得してるのはおかしい (4) 〃 フォルダパスとファイル名の間に｢\｣が足りない
等がおかしいと思います。
もし、気が変わって自分で頑張ってみるならば、ちゃんとインデントを付けてからステップ実行してみて、辻褄があうコードになっているのか確認してみることをおすすめします。
（もこな２ ） 2020/04/08(水) 08:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.