保存とは「何を」保存でしょうか?
またVBAは「何の」VBAでしょうか?「A1」と書いているのでExcelと思いますが、タグの追加をお願いします。
前提・実現したいこと
新しいシートにコピーする際に、中身が少し変わってしまう。
正しい値をコピーしたい
発生している問題・エラーメッセージ
新シートに貼り付けの部分で書式や行数はコピーできているが、値などが途中から違い、しっかりコピーできていない。 →ソースコードには問題はなでーたいのか? 例のように値が変わってしまっている。 例: ################ ################ # 移動番号 -1 # # 移動番号 -1 # ################ ################ # a # a 1 0 # b # b -1 0 # c # c 2 0 # d → # d 1 0 # e # e -90 0 # f # f 0 0 # g # g 0 0 0 0 0 0
該当のソースコード
VBA
1Sub aaa() 2 Application.ScreenUpdating = False 3 'コピー元の選択 4 Range("A15:E1163").Select 5 Selection.Copy 6 7 '追加したシートに名前を付ける 8 Dim ws As Worksheet 9 Set ws = Worksheets.Add 10 ws.Name = "log" 11 12 'コピー元を新シートに貼り付け 13 Range("A1").Select 14 ActiveSheet.paste 15 16 Dim rUsed As Range '// UsedRange 17 Dim r As Range '// Cell 18 Dim fs As New FileSystemObject '// FileSystemObject 19 Dim ts As TextStream '// TextStream 20 Dim sFilePath '// 出力ファイルパス 21 Dim iRow '// 現在行 22 Dim s '// 出力文字列 23 24 '// ファイルパス=ブックと同じフォルダ+シート名+.txt 25 sFilePath = ActiveWorkbook.Path & "\test(1).txt" 26 27 '// FileSystemObjectで新規ファイル作成 28 Set ts = fs.CreateTextFile(sFilePath, True, False) 29 30 '// シートの入力範囲の全セルを取得 31 Set rUsed = ActiveSheet.UsedRange 32 33 iRow = 0 34 35 '// 1セルずつループ 36 For Each r In rUsed 37 If iRow <> r.Row Then 38 '// ループ初回時ではない場合 39 If r.Row <> rUsed.Row Or r.Column <> rUsed.Column Then 40 '// 行が変わったため改行コードを付与 41 s = s & vbCrLf 42 End If 43 44 '// 行の先頭値を連結 45 s = s & r.Text 46 Else 47 '// タブ文字区切りで連結 48 s = s & vbTab & r.Text 49 End If 50 51 '// 現在行取得 52 iRow = r.Row 53 Next 54 55 '// セルの文字列が存在する場合 56 If s <> "" Then 57 Call ts.WriteLine(s) 58' Call ts.Write(s) 59' Call ts.Write(vbCrLf) 60 End If 61 62 '// ファイルClose 63 Call ts.Close 64 65End Sub 66 67
試したこと
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
あなたの回答
tips
プレビュー