Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


51136 / 76732 ←次へ | 前へ→

【30470】Re:別Bookのデータから一覧を作りたい
回答  かみちゃん E-MAIL  - 05/10/28(金) 7:11 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>同一フォルダ内にある複数のエクセルBook(Sheet1)から値を取り出し
>転記用のエクセルBook(Sheet1)に追加転記したいのですが、初心者ためなにもわかりません。

ほぼ、同様のことをしていましたので、私のマクロを少しだけ修正してみました。
以下のコードでご希望の動作はできると思います。
ただし、元ファイルの商品名列の途中に1行でも空欄があると、そこから下は削除
しますので、注意してください。
コードの内容は、あえて、説明は書かないでおきます。
もは、わからないことがあれば、ヘルプなどでお調べいただいて、わからないとこ
ろをポイントを絞っていただいた上で再度ご質問いただければと思います。

Sub Macro1()
 Dim MyPath As String, MyName As String
 
 Range("A1:E1").Value = Array("会社名", "担当者", "商品名", "定価", "価格")
 MyPath = ThisWorkbook.Path
 MyName = Dir(MyPath & "\*.xls")
 Do While MyName <> ""
  If MyName <> ThisWorkbook.Name Then
   Workbooks.Open MyPath & "\" & MyName
   Columns("A:B").Insert Shift:=xlToRight
   Range("A4", Range("D65536").End(xlUp).Offset(, -2)) = Array(Range("D1"), Range("D2"))
   Columns("C:C").Delete Shift:=xlToLeft
   Rows("1:3").Delete Shift:=xlUp
   Rows(Range("C65536").End(xlUp).Row + 1 & ":65536").Delete Shift:=xlUp
   Range("A1").CurrentRegion.Copy
   ThisWorkbook.Activate
   Range("A65536").End(xlUp).Offset(1).Select
   ActiveSheet.Paste
   Workbooks(MyName).Activate
   ActiveWorkbook.Saved = True
   ActiveWorkbook.Close
  End If
  MyName = Dir
 Loop
End Sub
0 hits

【30469】別Bookのデータから一覧を作りたい 初心者ひなです 05/10/28(金) 2:28 質問
【30470】Re:別Bookのデータから一覧を作りたい かみちゃん 05/10/28(金) 7:11 回答

51136 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free