|
ひげくま さん
レスありがとうございます。
>こんなに間違いが多いと、ここに正しく書いてあるものでも、実際のコードが間違っている可能性も考えてしまいます。
>そうなると、もう何も信じられなくなります。
申し訳ありません。
ファイル名が本当はわかりづらいもののため、質問時に書き換えていたのですが、ミスが本当に多く、ご迷惑おかけいたしました。
>既存ookって何ですか?
>既存Bookですよね?
その通りです。
実際にこのファイル名で実行済みのコードを記載させていただきます。
Copyメソッドを使った場合のものです。
----------------------------------------
xlsFile = Dir("C:\Documents and Settings\aa\" & "\*.xls", vbNormal)
'新規オブジェクト宣言
Set 新規App = CreateObject("Excel.application")
Set 新規Book = 新規App.Workbooks.Add
'指定されたフォルダ内のexcelがなくなるまで
Do While xlsFile <> ""
'既存オブジェクト宣言
Set 既存App = CreateObject("Excel.application")
Set 既存Book = 既存App.Workbooks.Open("C:\Documents and Settings\aa\" & xlsFile)
Set 新規Sheet = 新規Book.Worksheets(1)
Set 既存Sheet = 既存Book.Worksheets("1")
既存Sheet.Activate
既存Sheet.Range("A1").Copy Destination:=新規Sheet.Range("A1")
Set 既存Sheet = Nothing
Set 新規Sheet = Nothing
'既存エクセル終了処理
既存App.DisplayAlerts = False
既存Book.Save
既存Book.Close
既存App.Quit
Set 既存Book = Nothing
Set 既存App = Nothing
xlsFile = Dir()
Loop
'新規エクセル終了
新規App.DisplayAlerts = False
新規Book.SaveAs Application.ThisWorkbook.Path & "\Data.xls"
新規Book.Close
新規App.Quit
Set 新規Book = Nothing
Set 新規App = Nothing
----------------------------------------------------------
こうすると、
既存Sheet.Range("A1").Copy Destination:=新規Sheet.Range("A1")
でやはり、「Range クラスの Copy メソッドが失敗しました」となります。
今は試しで、セル一箇所のみコピーしています。
何度も申し訳ありません。
どうしても進めたいので、ご面倒おかけいたしますが宜しくお願いいたします。
|
|