EXCEL2000とEXCEL2003のVBAについて

現在、EXCEL2000で下記のコードを実行しています。
が、EXCEL2003で実行すると、 .UsedRange.Copy myb
のコードが実行されているのにコピー出来ていません。

ファイルは開いていて、エラーは出ていないのです。
問題点わかる方教えていただけますか？


Sub 日別データ読込()

Dim rngsaki As Range
Dim pathmacrobook As String
Dim namebook As String
Dim motobook As Workbook
Dim myb As Variant

Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2")
pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\"
namebook = Dir(pathmacrobook & "*.xls")

Do While Not namebook = ""


Set motobook = Workbooks.Open(pathmacrobook & namebook)
Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp)
With motobook.Worksheets("Sheet1")
.UsedRange.Copy myb
End With

motobook.Close False
namebook = Dir()

Loop

MsgBox "完了しました"
End Sub

No.1 ベストアンサー 回答者： Wendy02 回答日時： 2007/12/04 10:23

こんにちは。

まず、今回のマクロだけでは、

>Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2")
これは、生きていないですね。

実際に試したわけではないのですが、バージョンによって違いが出るとも思えないですね。

.Worksheets("Sheet1").UsedRange.Copy

ただ、ここが気になりますね。空の場合は、「1セル」しかコピーしませんが、それを貼り付けても、無駄になってしまいます。
絶対に、空はないならよいのですが、本当は、
If WorksheetFunction.CountA(Worksheets("Sheet1").Cells) >0 Then
などで、シートを検査したほうがよいと思いますね。なお、必ず、Sheet1 というシートがあるという前提です。

それから、最後尾の次になるから、myb.Offset(1) でしょうね。
正しく動くかは分かりませんが、書き換えてみました。

Sub 日別データ読込R()
　　Dim DestBook As Workbook
　　Dim pathmacrobook As String
　　Dim namebook As String
　　Dim myb As Range
　　
　　pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\"
　　
　　Set DestBook = Workbooks("残高集計用.xls")
　　namebook = Dir(pathmacrobook & "*.xls")
　　
　　Do While Not namebook = ""
　　　　Set myb = DestBook.Worksheets(3).Range("A65536").End(xlUp)
　　　　With Workbooks.Open(pathmacrobook & namebook)
　　　　　　　On Error Resume Next
　　　　　　　　.Worksheets("Sheet1").UsedRange.Copy myb.Offset(1)
　　　　　　　On Error GoTo 0
　　　　　　　.Close False
　　　　End With
　　　　namebook = Dir()
　　Loop
　　Set DestBook = Nothing
　　MsgBox "完了しました"
End Sub

この回答へのお礼

ありがとうございます！！

うまく動きました。

お礼日時：2007/12/05 00:37