1218293108 ExcelVBAです。


添付ファイルのようなことをしたいのですが

1)分割する行を選択する
2)VBAを実行
3)12行目から下を全て削除し、別名で指定フォルダへ保存
⇒別名で保存:商品別一覧yyyymmdd.xls (yyyymmddは当日)

4)5行目から11行目までを削除し、12行目以降を上方向へシフト(タイトル行の一行下)
⇒上書き保存

教えていただくと作業的に大変助かります。
宜しくお願い致します。

回答の条件
  • 1人3回まで
  • 登録:2008/08/09 23:45:11
  • 終了:2008/08/10 01:14:02

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/08/10 00:32:54

ポイント60pt

こんな感じでどうでしょう。

Sub Macro()
    Dim wb As Workbook
    Dim r As Long
    Dim bookName As String
    
    '保存するフォルダのパスを指定
    Const BookPath As String = "C:\Documents and Settings\hogehoge\デスクトップ\test"
    
    r = Selection.Row
    bookName = ThisWorkbook.Path & "\" & Format(Now, "yyyymmdd") & ".xls"
    ThisWorkbook.SaveCopyAs (bookName)
    Set wb = Workbooks.Open(bookName)
    ActiveSheet.Rows(r + 1 & ":65536").Delete shift:=xlUp
    wb.Save
    wb.Close
    
    ActiveSheet.Rows("5:" & r).Delete shift:=xlUp
    ThisWorkbook.Save
End Sub
id:hananeko_0

ありがとうございますっ (*^_^*)

私のスキルが低く申し訳ないのですが、別名で保存したファイルの名前が

日付だけになってしまうので、日付の前に元ファイルの名前を追加

したいのですが(商品別一覧yyyymmdd.xls )どうすれば良いでしょうか?

それから先ほど別件でSALINGERさんからいただいた回答ですが、

私の質問不足で、毎回指定する枚数が違うので、合計する枚数を指定する部分

(4000のところ)をInputboxで入力指定したいのですが、こちらは又質問にあげさせていただきます。

自力でトライしましたが出来ませんでした・・・(/_;)

もしお時間ありましたら、そちらもご回答いただくと大変助かります。

2008/08/10 00:50:43
  • id:SALINGER
    7行目
    ThisWorkbook.Path→BookPathでした。
  • id:SALINGER
    すいません。商品別一覧が抜けていましたね。

    bookName = BookPath & "\商品別一覧" & Format(Now, "yyyymmdd") & ".xls"

    にしてください。
  • id:hananeko_0
    SALINGERさん、ありがとうございます! (*^_^*)

    商品別一覧を頭につけたファイル名でデスクトップに保存されましたっ
    感謝ですっ

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません