【マクロ】2度貼付けを実行すると一つのセルに文字列が入った状態で貼付けされます。

初めて投稿します。
エクセルのマクロ初心者の質問です。

CSVファイルを読み込み、そこにあるデータを今現在開いているシートへ貼り付けを行う際に、一度目は特に問題ないのですが、隣のシートを開いて再度実行すると、何故か同じような貼り付けにならずにAセルからPセルに入っている文字列が全てAセルに結合されたような形で貼付けされます。

一度ファイルを閉じて再度開き、実行すると問題はないのですが、なにかコードが間違っているのでしょうか？

マクロ初心者で、頓珍漢な事を言っているかもしれませんが、どなたかお知恵をお貸しください。

よろしくお願いします。


Sub データー抽出()

Dim csvfilename As String

csvfilename = Application.GetOpenFilename("CSV ファイル , *.csv")
Workbooks.Open Filename:=csvfilename

' Copy CSV File
LastRow = Range("A65536").End(xlUp).Row
Range("A1:P" & CStr(LastRow)).Select
Selection.Copy
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

' Paste
Range("A1").Select
ActiveSheet.Paste

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2016/04/21 10:43

こんにちは。

私の印象としては、

ActiveSheet.Paste

ふつうなら、クリップボードに保存したものは、その前にExcelの中で大きな作業をする(保存やクローズ）と消えてしまうような気がしましたから、これが実行できること自体が意外なのです。それで、コード自体は問題ないとは思うのですね。

まあ、私ごときの技術で、人のコードの良い悪いなんていうのは、分不相応かもしれませんが、内容的には、その問題さえなければ、満点だと思います。

原因なのですが、たぶん、[データ]－[区切り位置]のユーティリティが初期化されていないのが原因ではないか、と思いました。まず、その部分をダミーを使って戻してみてください。(図を付けました）

最初に書いたように、クリップボードそのものよりも、コピーしたものがオブジェクトである以上は、その中身が問題になってくるわけです。

わたし流に書けば、また違うコードになりますが、それは後にします。

マクロの提案としては、

1. CSVファイルを開けて、
2. その範囲をコピーして
3. そのブックを閉じて
4. そして、アクティブになったシートに貼り付ける

この4と3を入れ替えたらどうか、という提案をしたいのです。直接の原因には触れていませんから、解決策にはなりませんが。

こんな感じです。
'//
Sub データ抽出2()
　　Dim Csvfilename As String
　　Dim AcSheet As Worksheet
　　Dim LastRow As Long
　　Dim myRng As Range
　　
　　Set AcSheet = ActiveSheet
　　Csvfilename = Application.GetOpenFilename("CSV ファイル , *.csv")
　　
　　With Workbooks.Open(Filename:=Csvfilename)
　　　　LastRow = .ActiveSheet.Range("A65536").End(xlUp).Row
　　　　Set myRng = .ActiveSheet.Range("A1:P" & CStr(LastRow))
　　　　myRng.Copy AcSheet.Range("A1")
　　　　Application.DisplayAlerts = False
　　　　.Close
　　　　Application.DisplayAlerts = True
　　End With
End Sub
'//
'-------------------
私のやり方も、あくまでもトレーニングとして考えてみました。

もともと、Open fn ～　For Input As は、わたしのテンプレートに入れてあったので、そのまま抜き出しました。複数のものをインポートできますが、最近は、ネットからダウンロードしたファイルは、UTF-8 のCSVファイルがあるので、しんきちさんのようなスタイルのほうがベターなのようです。あくまでも、以下は、SJISを元にした造りになっています。そのために、UTF-8 to SJIS 変換プログラムを入れるとしたら、かなり大掛かりになってしまいます。

'//
Sub CSVImport()
　　Dim Fname As Variant, fn As Variant
　　Dim FNo As Integer
　　Dim TextLine As String
　　Dim Ar As Variant
　　Dim i As Long, j As Long, indx As Long
　　'複数選択有り
　　Fname = Application.GetOpenFilename("CSV ファイル , *.csv", , , , True)
　　If TypeName(Fname) <> "Variant()" Then
　　　　Exit Sub
　　End If
　　For j = 1 To UBound(Fname)
　　　　i = 1 '貼り付け開始行
　　　　FNo = FreeFile()
　　　　fn = Fname(j)
　　　　Open fn For Input As #FNo
　　　　Application.ScreenUpdating = False
　　　　Do While Not EOF(FNo)
　　　　　　Line Input #FNo, TextLine
　　　　　　Ar = Split(TextLine, ",")
　　　　　　Cells(i, 1).Resize(1, UBound(Ar) + 1).Value = Ar
　　　　　　i = i + 1
　　　　Loop
　　　　Close #FNo
　　　　indx = ActiveSheet.Index
　　　　If j < UBound(Fname) Then　　'自動的に次のシートを開けるか、増やす
　　　　　　If indx < Worksheets.Count Then
　　　　　　　　Worksheets(indx).Next.Select
　　　　　　Else
　　　　　　　　Worksheets.Add After:=Worksheets(Worksheets.Count)
　　　　　　End If
　　　　End If
　　　　Application.ScreenUpdating = True
　　Next j
End Sub

この回答へのお礼

WindFallerさんへ

詳しい説明付きでとても助かりました。
2日間モヤモヤしてた気持ちが一気に晴れた気分です。

マクロは始めたばかりなのでこれからも質問することが多くなると思いますが、自己練磨して頑張ります。

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

お礼日時：2016/04/22 01:48