いつも参考にさせて頂いています。
今回もどなたかのお知恵が借りれる事を祈っております。

Aというファイルに入力されているデータのレイアウトは1行に1案件となっており、
列AからB、C、・・・と報告に必要な項目が並んでいます。
これを各行(=各案件)ごとに専用のファイル(Bファイル)に転写、別名で保存しています。因みにBファイルはAのファイルとはレイアウトが全く異なり、単純に行全体のコピペ~保存という訳にはいかなくて困っています。

■Aファイルのレイアウト
1 A   B   C   D   E   F   G   H   I   L  M
2 No 受付 日付  担当 起票日 起票者 所属  区分  内容 回答日 回答者  
3 1 1111 5/21 MKG 5/31 FSS 1-1 VDA gaga 6/3 GHQ
4 2 1321 5/22 FSB 6/11 CTU 3-1 NCA HAH 6/20 GHQ

データはB列からO列まで入力されていますが、JとKの情報はコピー不要です。
また行数(=案件数)は一定ではなく、何行目までデータが入っているか決まっていません。

■Bファイルへのペースト先(指定したセルにデータが入っている場合は上書き)
AファイルのB列のデータ・・・J5
AファイルのC列のデータ・・・H2
AファイルのD列のデータ・・・D3
AファイルのE列のデータ・・・D7
AファイルのF列のデータ・・・F7
AファイルのG列のデータ・・・I7
AファイルのH列のデータ・・・D8
AファイルのI列のデータ・・・C10
AファイルのL列のデータ・・・D19
AファイルのM列のデータ・・・F19
AファイルのN列のデータ・・・C22

■コピペ後の処理(コピペしたBファイルの別名保存)
BファイルのJ5に貼付けたデータをそのままファイル名としてローカルのデスクトップに保存します。

以上です。
お知恵を貸して下さい!

A 回答 (9件)

> 通しNoが100まで振ってあり、案件が記載してある行は30番までという状況でした。



原因はこれでしたね。
Noとデータ数が常に一致すると限らないなら、Noの列をマクロでは見ないようにしたほうが良かったですね。
そこまで気が回らなかったわたしの落ち度です。反省
(^^;;

B列の「受付」ならデータ数が常に一致するのであれば、cj_moverさまがおっしゃるように
For n = 3 To ws(0).Cells(Rows.Count, "B").End(xlUp).Row
と、B列見るように変えてください。

cj_moverさま、お久しぶりです。
merlionXXはいつまでも未熟で困ったものです。
┐(´∇`)┌
    • good
    • 0

Re


 
ん?
Aファイルで主キーにあたるものはB列にある"受付"なのですから
 回答No.1の記述で
  For n = 2 To ws(0).Cells(Rows.Count, "A").End(xlUp).Row
 の "A" を "B" に正したら案外呆気なく通る
というのが可能性高い気がします。
具体的なデータを見てないので確率的な話ですが試す価値はあるかと。
    • good
    • 0

masurao200さんも苦労しているようですね。



> 頂いた内容を実行してみると、デスクトップと表示された窓がピコっと出てきます。

デスクトップのパスがちゃんと返ったということですね?

> これを実行するとファイルが生成され最後に実行エラーが出て、Book●●がポツンと存在しています。
> そのままデバッグを押してみると↓の一文が黄色く塗られていました。

わたしも、あなたの掲示したコードをそのままコピペして試してみましたが、ちゃんとデスクトップに複数のBOOK生成されました。
masurao200さんもファイルが生成されデスクトップに保存されているけど、最後にひっかかっちゃうということですね?
こちらではあなたのファイルやパソコンを見ることができないので想像するしかありません。

CreateObject("WScript.Shell").SpecialFolders("Desktop") で取得したパスに続く & "\" & ws(1).Range("E3").Value でファイル名を設定しています。

これらの状況から考えられるのは、エラーになったとき、BファイルのSheet1のE3セルの値が、ファイル名に使えない文字(\/:*?"<>|など)を含んでいるのではないでしょうか?
あるいはひょっとしてすでにデスクトップに存在するファイル名だったとか?
確認してみてください。
あと、AファイルのA列にはデータ数だけNoがふってありますね?
そうでないとデータの数だけファイルが作られませんので。
    • good
    • 0
この回答へのお礼

merlionXX様


いつも本当にありがとうございます。
お蔭様でエラーなく完了することができました。

>あと、AファイルのA列にはデータ数だけNoがふってありますね?
>そうでないとデータの数だけファイルが作られませんので。

実はこの部分を読ませていただき、急いでAファイルを見てみたところ、通しNoが100まで振ってあり、案件が記載してある行は30番までという状況でした。
慌てて31番~100番を消して再度実行してみたところ、エラーなく複製もきちんとコピーされていました。

私の未熟な質問のせいでお手数をかけ、ただただ感謝です。

質問の仕方、マナー、本件以外にも色々と勉強をさせて頂きました。

本当にありがとうございました。

お礼日時:2011/08/12 12:57

お邪魔します。



No.1へのお礼に
>A、BどちらもデスクトップにA、Bという名前で保存しています。
とありますから、デスクトップのパス取得に拘らずに
ThisWorkbook.Pathでフォルダを取得する方が後々楽かも知れません。
もっとも、私は、デスクトップにはショートカットしか保存しない主義ですし、
いずれ、どこかのフォルダに格納しなければならない訳ですから、
一時的にであっても、デスクトップにファイル保存するようなプログラムは好みません。
Aファイル、Bファイル、新規に作成するファイル、皆、同一のフォルダに置く
という条件で解釈換えをしてみました。(むしろ一般的な処理です)
同一のフォルダ=デスクトップ、という条件でも当然動きます。

merlionXX さんは結合セルのエキスパートですから、
結合セルが原因で動かないようなものを書くことは滅多にないと思います。
今回、質問者さんが途中から結合セルがエラーの原因と考えて
(そういう疑問を持つことや尋ねることは、寧ろポジティブなことですが)
原質問とは全く異なる(転記するデータの数まで変わってしまう)条件変えをしたのは、
ちょっと勇み足かな、と思います。
回答者としては、継続的なレスポンスが難しくなってしまうのではないでしょうか。
→私が書くのはあくまで、No.5へのお礼が記される前までの情報から類推されるニーズ
に応えるものです。

ところで、
 ファイルAのデータは、
  直に値を入力したものですか?
   それとも他のファイルから取り込んだ(orコピーした)ものですか?
   或いは、数式で他のデータを参照したものでしょうか?
  空白セルや空行はありますか?
なるべく、こういう情報も盛り込むように質問すると、返ってくる内容が充実することが多いです。
(回答者が確認すれば済む、というのも一理、、、)
→B列が空白の場合は転記も新規作成もしないように書きました。
Excelだけでなく表計算ソフト一般にいえる事ですが、
 3-1
のような値は(VBAとは関係なく)結構脆弱です。
文字列として扱うのに、セルの書式設定で文字列を指定することは勿論ですが、
データとして堅牢なものにする為には先頭にプレフィックス「'」を付けた方が確実です。
私は他の表記に換えることが多いですけれど、避けられない場合は
必ず入力(or取り込み)の段階でプレフィックスを付けるようにしています。
→AファイルのG列にプレフィックスを付加するように書いてます。
→そうしたくない場合は◆マークした行を削除してください。
また、Bファイルの転記先のうち、H2,D7,D19については
事前に適切な書式設定(日付)が済んでいるか確認してください。

どちらかというと確認のために書いたコードです。
レスポンスがあれば(日を置いてもよければ)また対応しますが、
本心はmerlionXX さんの手で解決されることを望んでいます。
とりあえず、動作確認をお願いします。

Sub Records2ReportsCrNewBk() ' okg6925811
 Dim vKey As Variant
 Dim wbkRepo As Workbook ' ファイルBブック
 Dim shTbl As Worksheet ' ファイルAシート
 Dim rngTbl As Range ' 元データ(ファイルA)のセル範囲
 Dim rngRepo As Range ' レポート出力先(ファイルB)のセル範囲
 Dim r As Range ' ループ用
 Dim sNrwNmTmpl As String '新規レポートブックのフルネーム雛型
 Dim sNewNm As String ' 新規レポートブックのフルネーム
 Dim nBtmRow As Long ' 元データのデータ最下行
 Dim i As Long, j As Long ' ループ用
 With ThisWorkbook
  Set shTbl = .Sheets("Sheet1")
  sNrwNmTmpl = .Path & "\?.xls"
  nBtmRow = shTbl.Cells(Rows.Count, 2).End(xlUp).Row
  Set rngTbl = shTbl.Range("B:N")
 End With
 On Error GoTo OpenTmpl_
 Set wbkRepo = Workbooks("B.xls")
 On Error GoTo 0
 Set rngRepo = wbkRepo.Sheets("Sheet1").Range("J5,H2,D3,D7,F7,I7,D8,C10,D19,F19,C22")
 For i = 2 To nBtmRow
  With rngTbl.Rows(i)
   vKey = .Cells(1).Value
   If vKey <> "" Then
    j = 0
    For Each r In rngRepo.Areas
     j = j + 1
     Select Case j
      Case 6: .Cells(j).Value = "'" & .Cells(j).Value ' ◆
      Case 9: j = 11
     End Select
     r.Value = .Cells(j).Value
    Next r
    sNewNm = Replace$(sNrwNmTmpl, "?", vKey)
    wbkRepo.SaveAs sNewNm
   End If
  End With
 Next i
' wbkRepo.Close False
Exit_:
 Set wbkRepo = Nothing: Set shTbl = Nothing: Set rngTbl = Nothing: Set rngRepo = Nothing
 Exit Sub
OpenTmpl_:
 Workbooks.Open ThisWorkbook.Path & "\B.xls"
 Resume
End Sub
    • good
    • 0
この回答へのお礼

Cj mover様

お礼が遅くなりましたが、本日目的を果たす事ができました。
教えて頂いたコードでも動作確認させて頂きました。無事、動いております。

質問の仕方、マナーの大切さなどこうしたコミュニティを有効に活用するために大事な事も教えて下さり、本当にありがとうございました。

まだまだ知りたい事が沢山あり、これからも使わせて頂くと思いますので、お時間があればまた教えて下さい。

本当にありがとうございました。

お礼日時:2011/08/12 23:10

ANo4での質問を訂正します。



Sub パス取得()
Dim wb As Workbook
Dim ws(1) As Worksheet
Set wb = Workbooks("B.xls") 'Bファイル指定
Set ws(1) = wb.Sheets("Sheet1") 'Bファイルの転記先シート指定
MsgBox CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("J5").Value
End Sub

では、どう返りますか?
    • good
    • 0
この回答へのお礼

merlionXX様

いつもありがとうございます。面倒かけて申し訳ありません。

頂いた内容を実行してみると、デスクトップと表示された窓がピコっと出てきます。
特にエラーは生じませんでした。

また、Bファイルで指定していた転写先のセルのうち、結合されていたものを全て解除してみました。
セル名が変わったので、最初に頂いた構文のセル名を全て書き換えてみたところ、進展がありました。
実行してみると、各案件別のファイルが生成されデスクトップに保存されています。
しかし、最後に実行時エラーが出てきてしまい、ファイル名の付いていないBook●●(←その時々の数字)が生成されたものの何も転写されておらず保存もされなく開いていました。

セル名を書き直したものは↓です。

Sub test01()
Dim wb As Workbook
Dim ws(1) As Worksheet
Dim myW, myX
Dim i As Long, n As Long
Set wb = Workbooks("B.xls") 'Bファイル指定
Set ws(0) = ThisWorkbook.Sheets("Sheet1") 'Aファイルの転記元シート指定
Set ws(1) = wb.Sheets("Sheet1") 'Bファイルの転記先シート指定

myW = Split("B,C,D,E,F,G,I,L,M,N", ",")
myX = Split("E3,E2,C3,C5,E5,E6,B9,C16,E16,B19", ",")

For n = 3 To ws(0).Cells(Rows.Count, "A").End(xlUp).Row
For i = LBound(myW) To UBound(myW)
ws(1).Range(myX(i)).Value = ws(0).Range(myW(i) & n).Value
Next i
ws(1).Copy
ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("E3").Value
ActiveWindow.Close (False)
Next n

End Sub

これを実行するとファイルが生成され最後に実行エラーが出て、Book●●がポツンと存在しています。
そのままデバッグを押してみると↓の一文が黄色く塗られていました。

ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("E3").Value

稚拙な表現ですいません。
何とか助けてください。宜しくお願いいたします。

お礼日時:2011/08/10 20:46

悩ましいですねえ。


マクロはAファイルに書いたのですよね?

Sub デスクトップ取得()
 MsgBox CreateObject("WScript.Shell").SpecialFolders("Desktop")
End Sub

は、正しく表示されるのですね?
では

Sub パス取得()
 Set wb = Workbooks("B.xls") 'Bファイル指定
 Set ws(1) = wb.Sheets("Sheet1") 'Bファイルの転記先シート指定
 MsgBox CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("J5").Value
End Sub

ならどうなりますか?
(B.xlsを開いたままで試してください)
    • good
    • 0

merlionXXです。



Windows2000でエクセル2000
WindowsXPでエクセル2003
両方で試しましたがエラーになりません。

Sub デスクトップ取得()
 MsgBox CreateObject("WScript.Shell").SpecialFolders("Desktop")
End Sub

で、どう返りますか?
これもエラーならWindowsじゃないのでは?
デスクトップのパスを取得するためにWindows Script Hostを使ったので、Windows環境でなきゃだめなんです。
どうしてもだめなら、
ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("J5").Value
をあなたのデスクトップのパスをそのまま文字列で指定してみてください。

この回答への補足

>転写先が結合しているセルもあります。

大変失礼しました。
転記先のセルの中にはいくつかのセルを結合したものもあり、結合したセルを選択すること自体が何らかの障壁になるかと思って記しました。

関係なければ無視してくださって結構です。

よろしくおねがいします!

補足日時:2011/08/09 17:47
    • good
    • 0
この回答へのお礼

merlionXX様


ご回答ありがとうございます。
当方環境もWinXP&EXCEL 2003です。

頂いたデスクトップ取得については問題なく、ポップアップの画面が掲示されます・
しかし下記ご提供いただいたもので試しますと、同じエラーができます。

ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("J5").Value

エラーの内容は上記の全文が黄色くセル反転されます。
動作を見ていると、新規ファイルを起こして、そこで終わりです。
新規ファイルには名前は付いていなく、Aファイルからの転写もできていません。
転写先が結合しているセルもあります。

お手数ばかりかけて申し訳ございません。
回答お待ちしております!

お礼日時:2011/08/09 16:46

merlionXXです。



> デバックを選択すると、下記の一文が黄色く反転しています。
> ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop")

あなたのデスクトップのパスを取得する部分ですね。
ここがエラーですか・・・。
あなたのエクセルのバージョンは何でしょう?
    • good
    • 0
この回答へのお礼

ありがとうございます。
本来なら最初の質問で記しておくべきでした。すいません。

エクセルのバージョンは2003です。


よろしくお願いします。

お礼日時:2011/08/09 00:57

一例です。


Aファイルの2行目からデータがあるものとしています。
シート名が不明だったので、A,BファイルともにSheet1としています。
Bファイルは、B.xls としていますが実情に合わせてください。
以下のマクロはAファイルの標準モジュールに記入してください。
実行時にはABファイルともに開いておいてください。

Sub test01()
  Dim wb As Workbook
  Dim ws(1) As Worksheet
  Dim myW, myX
  Dim i As Long, n As Long
  Set wb = Workbooks("B.xls") 'Bファイル指定
  Set ws(0) = ThisWorkbook.Sheets("Sheet1") 'Aファイルの転記元シート指定
  Set ws(1) = wb.Sheets("Sheet1") 'Bファイルの転記先シート指定
  
  myW = Split("B,C,D,E,F,G,H,I,L,M,N", ",")
  myX = Split("J5,H2,D3,D7,F7,I7,D8,C10,D19,F19,C22", ",")
  
  For n = 2 To ws(0).Cells(Rows.Count, "A").End(xlUp).Row
    For i = LBound(myW) To UBound(myW)
      ws(1).Range(myX(i)).Value = ws(0).Range(myW(i) & n).Value
    Next i
    ws(1).Copy
    ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & ws(1).Range("J5").Value
    ActiveWindow.Close (False)
  Next n
  
End Sub
    • good
    • 0
この回答へのお礼

さっそくご教示いただきありがとうございます。
実行してみたところ、下記のようなエラーが出ました。

実行時エラー1004

ファイルにアクセスできませんでした。次のいずれかを行ってみてください。
?指定したフォルダがあることを確認します
?ファイルを含むフォルダが読み取り専用になっていないことを確認します
?指定したファイルの名前に次のいずれかの文字も含まれていないことを確認します
<>?[]|:
?ファイル名およびパス名が半角218文字より長くないことを確認します

上から順番に確認しましたが、特に引っかかるものは見当たりません。
A、BどちらもデスクトップにA、Bという名前で保存しています。
シート名もA、BともにSheet1です。

デバックを選択すると、下記の一文が黄色く反転しています。

 ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop")

文中にエラーの原因があるのでしょうか?
教えてください!!!

また出来ましたら、Aファイルの3行目からデータがあるものとして頂けると本当に助かります。

よろしくお願いします。。。

お礼日時:2011/08/08 21:43

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

今、見られている記事はコレ!

  • 縦書きと横書きはどちらが読みやすい?

    普段何気なく読んでいる文章ですが、縦書きか横書きか、意識したことはありますか?制作側としては読み手はどちらの方が読みやすいと思うかはとても大きな問題です。教えて!gooには、 「『横書き』と『縦書き』、...

  • 昭和の日ってどういう日?

    ゴールデンウィーク初日の4月29日は「昭和の日」です。今や平成生まれの人も多い時代ですが、「なぜ昭和の日があるの?」という疑問をもったことはありませんか?和暦を挙げるのなら、大正の日、明治の日、平成の日...

  • Excelの意外な使い方とは?

    会社のパソコンに必ず入っている、と言っても過言ではない、Office系ソフトの「Word」と「Excel」。PCを使う職場にいた方なら、一度は触ったことがあるかと思います。Wordは仕事以外に使う方法がすぐ浮かびそうです...

  • 【いつまで…?】中1息子にハグする母

    子育ての悩みはこれといった「正解」がないだけに悩みがつきものだ。自分のしていることが誤りではないか、あるいは間違っているのではないかと、親の多くは不安がっている。 「教えて!goo」で「中学一年生の息子...

  • 「好きな猫種ランキング2016」が発表、1位に輝いたのは……

    アイリスペットどっとコム会員(926名)を対象に行われたアンケートの結果が発表され、「好きな猫種ランキング2016」が明らかになった。3位は、まんまる顔に丸みのある体型がかわいらしいスコティッシュ・フォールド...

おしトピ編集部からのゆる~い質問を出題中

お題をもっとみる

このQ&Aを見た人が検索しているワード


このカテゴリの人気Q&Aランキング

おすすめ情報

カテゴリ