[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『実行時エラー '1004'「RangeクラスのPasteSpecialメソッドが失敗」』（QP）
こんにちわ。
・流れ・
システム屋さんが作ってくれた端末でデータを抽出してコピーします。（Excelは開いたままにしてます。）
下記のコードが入ったボタンを押します。
すると、
実行時エラー '1004'「RangeクラスのPasteSpecialメソッドが失敗」
というエラーが出たり出なかったりします。
対策方法はありますでしょうか？
宜しくおねがいします。
Sub 国際パーツ確認リスト()
Range("A1").PasteSpecial Paste:=xlPasteValues
Range("A1:L6000").Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Range("B1", ActiveSheet.UsedRange).Offset(9)
.Columns(.Columns.Count + 1).Formula = "=IF(OR(B10="""",B10=""伝票番号""),True,"""")"
On Error Resume Next
.Columns(.Columns.Count + 1).SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow.Delete
On Error GoTo 0
.Columns(.Columns.Count + 1).ClearContents
End With
Range("D:D,G:G,H:H,J:J,K:K").Delete Shift:=xlToLeft
End Sub
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
ﾃﾞｰﾀ抽出元のシート名と ﾃﾞｰﾀ抽出先のシート名を教えてください。 シートを指定すれば、問題は解決します。 （マリオ） 2017/02/13(月) 15:37
ﾃﾞｰﾀ抽出元のシート名=出荷ｽｹｼﾞｭｰﾙ
ﾃﾞｰﾀ抽出先のシート名=国際ﾊﾟｰﾂ
です。
宜しくおねがいします。
（QP） 2017/02/13(月) 15:42
または、なにも元をコピーせずに実行した、とか？
（???） 2017/02/13(月) 15:48
先頭行で黄色のマーカーのようになりエラーがでました。
連結というのは結合のことでしょうか？
（???）さんのお言葉で気づいたのは、抽出されたデータはところどころセルの結合がされています。
結合されていてもマクロは組めるのかもしれませんが、ＱＰちゃんはやり方がわからないので
Range("A1:L6000").Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
と、適当な範囲でセルの結合を解除するマクロの記録をいれています。
なにも元をコピーせずに実行した可能性があるのでは？
との事ですが、元データがキリトリ線がくるくる回っているようなのを確認してからボタンを押している
ので、コピーのし忘れではないと思います。
（QP） 2017/02/13(月) 16:07
>QP さん ********************************************************************** ﾃﾞｰﾀ抽出元のシート名=出荷ｽｹｼﾞｭｰﾙ → ★例）A.xlsx ﾃﾞｰﾀ抽出先のシート名=国際ﾊﾟｰﾂ → ★例）B.xlsm（マクロ実行ブック）
(1)A.xlsxの「出荷ｽｹｼﾞｭｰﾙ」シートを★手作業で、セル範囲をコピー
(2)B.xlsmの「国際ﾊﾟｰﾂ」シートに貼付けたボタンを押してマクロを実行
**********************************************************************
・状況は、上記のような感じでしょうか？
・コードは、すべて提示してますか？他にありますか？
・値のみを貼り付けているの（〜PasteSpecial Paste:=xlPasteValues）で、
そもそも、セルの結合を解除するマクロの記録をいれる必要がないですね。
・With Range("B1", ActiveSheet.UsedRange).Offset(9)以降は、
ﾃﾞｰﾀ抽出先のシート（シート名：国際ﾊﾟｰﾂ）でやりたいことですよね？
ちょっと、くわしく教えてください。どの列に数式を入れたいなど。
（マリオ） 2017/02/13(月) 17:13
With Range("B1", ActiveSheet.UsedRange).Offset(9)以降のコードは見てません！
次のマクロを実行すると、コピー元を手作業でコピーする必要はありません。
また、書式設定は、★シートの全データを削除しているので、
「.VerticalAlignment = xlCenter」以外は必要ない。
書式については、次が参考になるとおもいます。
http://officetanaka.net/excel/vba/cell/cell06.htm
Sub test2()
'----- 開いているブックが2つでないと、終了 --------------------
If Workbooks.Count <> 2 Then
MsgBox "開いているブックが2つでないので終了します"
Exit Sub
End If
'----- ﾃﾞｰﾀ抽出先のシートを初期化（シート名：国際ﾊﾟｰﾂ）-----
Dim sh2 As Worksheet
Set sh2 = ThisWorkbook.Sheets("国際ﾊﾟｰﾂ")
sh2.Cells.Clear '★シートの全データを削除（値だけでなく、書式も削除）
'----- ﾃﾞｰﾀ抽出元のシートをコピー（シート名：出荷ｽｹｼﾞｭｰﾙ）-----
Dim sh1 As Worksheet
Dim bk As Workbook
For Each bk In Workbooks
If bk.Name <> ThisWorkbook.Name Then
Set sh1 = bk.Sheets("出荷ｽｹｼﾞｭｰﾙ")'★シートがないとエラーになります
sh1.Range("A1", sh1.UsedRange).Copy
End If
Next bk
'----- ﾃﾞｰﾀ抽出先のシートに貼り付け（シート名：国際ﾊﾟｰﾂ）-----
sh2.Range("A1").PasteSpecial Paste:=xlPasteValues '★値のみ貼り付ける
Application.CutCopyMode = False 'キリトリ線がくるくる回っているようなのを解除
'----- ﾃﾞｰﾀ抽出先のシート（シート名：国際ﾊﾟｰﾂ）の書式設定-----
With sh2.Range("A1", sh2.UsedRange)
.VerticalAlignment = xlCenter '上下位置（垂直位置）は真ん中
End With
MsgBox "コピペしました"
End Sub
（マリオ） 2017/02/13(月) 17:13
ありがとうございます。
大変申し訳ありませんが、会社に残ると怒られてしまうので
また明日回答します。
親切に対応して頂いているのに申し訳ありません。。
（QP） 2017/02/13(月) 18:13
こんばんわ。
???さんと被りますが、 >実行時エラー '1004'「RangeクラスのPasteSpecialメソッドが失敗」 このエラーが出るのは、
1、貼付け先に結合セルがある時 2、コピーモードになっていない時(キリトリ線がくるくる回っていない時) 3、マクロの実行ダイアログから実行した時(この場合は貼付け先に結合セルが無くてもエラーになります) くらいだと思うんですけど、
マリオさんも言われてるようにシート指定をしていないので、実行タイミングによっては元のシートに貼り付けようとしてしまって、 元のシートは結合セルがあるのでエラーになったとかは考えられませんか？
他にも気になる事が、まぁマリオさんのコードで解決するなら別に良いんですけど、なぜコピーの記述が無いのかなぁと？ コピーの記述のあるコードは別にあるんですか？ それともコピーしたい範囲が都度不規則で決めれない為、手動でコピーだけして貼り付けてるとかですか？
（sy） 2017/02/14(火) 00:00
おはようございます。
********************************************************************** ﾃﾞｰﾀ抽出元のシート名=出荷ｽｹｼﾞｭｰﾙ → ★A.不明・・なぜ不明かと言いますと ﾃﾞｽｸﾄｯﾌﾟに保存すれば「xls」ってなってますがﾃﾞｽｸﾄｯﾌﾟに保存したﾃﾞｰﾀだと ﾏｸﾛが動かないので、ｼｽﾃﾑ屋さんが作ってくれた端末でｽｹｼﾞｭｰﾙ表が抽出された Excelを保存せず手動でｺﾋﾟｰしています。
ﾃﾞｰﾀ抽出先のシート名=国際ﾊﾟｰﾂ → ★例）B.xlsm←そうです。（マクロ実行ブック）
(1)A.xlsxの「出荷ｽｹｼﾞｭｰﾙ」シートを★手作業で、セル範囲をコピー←ほぼそうです。 ほぼと言うのはｼｰﾄ全体をｺﾋﾟｰしているからです。A列と1行目の間のところをｸﾘｯｸして います。 (2)B.xlsmの「国際ﾊﾟｰﾂ」シートに貼付けたボタンを押してマクロを実行 ********************************************************************** ・状況は、上記のような感じでしょうか？ はい。 ・コードは、すべて提示してますか？他にありますか？ すべて掲示してあります。 ・値のみを貼り付けているの（〜PasteSpecial Paste:=xlPasteValues）で、 そもそも、セルの結合を解除するマクロの記録をいれる必要がないですね。 そうでした！ありがとうございます!!
・With Range("B1", ActiveSheet.UsedRange).Offset(9)以降は、
ﾃﾞｰﾀ抽出先のシート（シート名：国際ﾊﾟｰﾂ）でやりたいことですよね？
はい、そうです。
ちょっと、くわしく教えてください。どの列に数式を入れたいなど。
はい、B列に伝票番号と書いてあったらそれを消す。
B列に空白があったら、空白の行を消す。
D,G,H,J,K列をDeleteする。
です。
（QP） 2017/02/14(火) 10:51
手作業でコピーする必要ないｺｰﾄﾞ、ありがとうございます。
普段はボタンを押してマクロを実行していますが、このｺｰﾄﾞはｼｮｰﾄｶｯﾄを用意して使用するのでしょうか？
もしも他にExcelが複数開いていた場合は使用できるのでしょうか？
（QP） 2017/02/14(火) 13:10
こんにちわ。
1、貼付け先に結合セルがある時←今回は貼り付け先に結合セルない。 2、コピーモードになっていない時(キリトリ線がくるくる回っていない時)←クルクル確認済み 3、マクロの実行ダイアログから実行した時(この場合は貼付け先に結合セルが無くてもエラーになります)←？
この三つが【実行時エラー '1004'「RangeクラスのPasteSpecialメソッドが失敗」】であれば、
QPちゃんは3に当たりそうですね！
Excelシートに貼り付けてから、ﾏｸﾛを組む。ってぐらいしか勉強できていないので、
ｺﾋﾟｰは手作業でｼｰﾄ全体をｺﾋﾟｰしています。
今後、こうゆうのがやれるようになりたいな！っと思う内容は、
AのExcelシートの○○列をみて**以上の場合BのExcelのSheetあいうのB4以降に貼り付けて･･･みたいなことを
習得していきたいです。
興味があるので楽しいです(*^^)
（QP） 2017/02/14(火) 14:57
自動でｺﾋﾟﾍﾟされるｺｰﾄﾞをやってみましたが、抽出した元データを保存しないと
「開いているブックが2つでないので終了します」とでました。
システム屋さんが作ってくれたものでｽｹｼﾞｭｰﾙ表を抽出した後、
そのExcelをﾃﾞｽｸﾄｯﾌﾟに保存するには、ファイル→名前を付けて保存→ﾏｲｺﾝﾋﾟｭｰﾀ→DL***のC→ﾕｰｻﾞ→･･･と
やらないとﾃﾞｽｸﾄｯﾌﾟに保存されないように作られている？ようです。
ﾃﾞｽｸﾄｯﾌﾟに保存してからなら「ｺﾋﾟﾍﾟしました」と出ました!
（QP） 2017/02/14(火) 16:30
>QP さんへ
>はい、B列に伝票番号と書いてあったらそれを消す。 >B列に空白があったら、空白の行を消す。
この順番で、作業すると、 B列に伝票番号と書いてあれば、（空白になって、その後、） その行を消すことになりますが、よろしいですか？
***************************************************************** >普段はボタンを押してマクロを実行していますが、 >このｺｰﾄﾞはｼｮｰﾄｶｯﾄを用意して使用するのでしょうか？
データ抽出先シート「国際ﾊﾟｰﾂ」シートがあるエクセルファイルに、 次のシートを追加してください。 ★「シート名：ボタン」 その後で、下記のマクロ【Sub ボタン作成】を実行してください。 ボタンシートのA1セルに、マクロ【Sub 国際パーツ確認マクロ】 を実行できるボタンを貼り付けます。 ***************************************************************** もしも他にExcelが複数開いていた場合は使用できるのでしょうか？ 使用できるように、ｺｰﾄﾞを書き換えました。
ただし、次の場合は、途中終了します。詳しくは、ｺｰﾄﾞで確認してください。 ・マクロを記述しているﾌﾞｯｸに、「国際ﾊﾟｰﾂ」シートがないと途中終了 ・「出荷ｽｹｼﾞｭｰﾙ」シートがない、または、複数あると途中終了
***************************************************************** >ﾃﾞｽｸﾄｯﾌﾟに保存してからなら 下記のコードでは、どうですか？ デスクトップに保存しなくても、使えませんか？ デスクトップに保存しない状態で、下記のコードを実行すると どうなったかおしえてください。
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Option Explicit
Const name1 As String = "出荷ｽｹｼﾞｭｰﾙ" '★ﾃﾞｰﾀ抽出元シート Const name2 As String = "国際ﾊﾟｰﾂ" '★ﾃﾞｰﾀ抽出先シート
Sub 国際パーツ確認マクロ()
'------- ﾃﾞｰﾀ抽出先シートの存在確認 --------------------------------
Dim ws As Worksheet, flag1 As Boolean
flag1 = False
For Each ws In ThisWorkbook.Sheets
If ws.Name = name2 Then flag1 = True
Next ws
If flag1 = False Then
MsgBox "ﾃﾞｰﾀ抽出先のシート" & vbCr & "「" & name2 & _
"」 が見つからないので、終了します"
Exit Sub
End If
'------- ﾃﾞｰﾀ抽出元シートの存在確認 --------------------------------
Dim wb As Workbook, n As Long
n = 0
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
For Each ws In wb.Worksheets
If ws.Name = name1 Then n = n + 1
Next ws
End If
Next wb
If n = 0 Then
MsgBox "ﾃﾞｰﾀ抽出元のシート" & vbCr & "「" & name1 & _
"」 が見つからないので、終了します"
Exit Sub
ElseIf n >= 2 Then
MsgBox "ﾃﾞｰﾀ抽出元のシート" & vbCr & "「" & name1 & _
"」 が複数見つかったので、終了します"
Exit Sub
End If
'----- ﾃﾞｰﾀ抽出先のシートを初期化（書式も削除）-----------------------
Dim sh2 As Worksheet
Set sh2 = ThisWorkbook.Sheets(name2)
sh2.Cells.Clear
'----- ﾃﾞｰﾀ抽出元のシートをコピーする --------------------------------
Dim sh1 As Worksheet
Dim bk As Workbook
For Each bk In Workbooks
If bk.Name <> ThisWorkbook.Name Then
Set sh1 = bk.Sheets(name1)
sh1.Range("A1", sh1.UsedRange).Copy
End If
Next bk
'----- ﾃﾞｰﾀ抽出先のシートに貼り付け（値のみ）（CopyMode解除）---------
sh2.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'----- ﾃﾞｰﾀ抽出先のシートの書式設定（垂直位置は真ん中） --------------
With sh2.Range("A1", sh2.UsedRange)
.VerticalAlignment = xlCenter
End With
'----- ﾃﾞｰﾀ抽出先のシート、調整(1)〜(3) ------------------------------
Dim fr As Long, myRng As Range, c As Range, myRng2 As Range
fr = sh2.Cells(Rows.Count, "B").End(xlUp).Row
Set myRng = sh2.Range(sh2.Cells(1, "B"), sh2.Cells(fr, "B"))
For Each c In myRng
If c.Value = "伝票番号" Then
c.Value = "" '(1)B列に伝票番号と書いてあったら、それを消す。
End If
If Len(Trim(c.Value)) = 0 Then '(2)B列に空白があったら
If myRng2 Is Nothing Then
Set myRng2 = c.EntireRow
Else
Set myRng2 = Union(myRng2, c.EntireRow)
End If
End If
Next c
If Not (myRng2 Is Nothing) Then myRng2.Delete '(2)空白の行を消す｡
sh2.Range("D:D,G:G,H:H,J:J,K:K").Delete Shift:=xlToLeft '(3)列削除
'------- 後処理 --------------------------------------------------------
sh2.Activate 'シートをアクティブにする
Set sh1 = Nothing: Set sh2 = Nothing
Set myRng = Nothing: Set myRng2 = Nothing
MsgBox "処理終了！"
End Sub
Sub ボタン作成()
Dim B As Object
Dim btn1 As Button
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("ボタン")
sh.Rows("1:1").RowHeight = 27 ' 高さ27 (36ピクセル)
For Each B In sh.Buttons
B.Delete 'ボタン全削除
Next B
'***************************************************************************
With sh
Set btn1 = .Buttons.Add(.Cells(1, 1).Left, _
.Cells(1, 1).Top, _
.Cells(1, 1).Width, _
.Cells(1, 1).Height)
End With
With btn1
.OnAction = "国際パーツ確認マクロ"
.Text = "実行"
.Name = "Button_1"
End With
'***************************************************************************
End Sub
（マリオ） 2017/02/14(火) 20:04
こんにちわ。
>B列に伝票番号と書いてあれば、（空白になって、その後、） >その行を消すことになりますが、よろしいですか？
はい。伝票番号というのは不要なので。
作っていただいたｺｰﾄﾞで試してみたところ、
やはり保存しないと「ﾃﾞｰﾀ抽出先のシート出荷ｽｹｼﾞｭｰﾙがが見つからないので、終了します」
とでました。保存すればマクロが動きました。
保存してなければ拡張子がない？から仕方ないんですかね？
保存すればできるので保存します！
後付けで申し訳ありませんが、1行目から9行目までは空白があっても動かしたくなかったです。。
行・列って覚えたんでBの10行目は（10,2）
fr = sh2.Cells(Rows.Count, "B").End(xlUp).Rowを
fr = sh2.Cells(10, 2), Cells(Rows.Count, "B").End(xlUp).Rowにしても
fr = sh2.Cells(Rows.Count, "B10").End(xlUp).Rowでもうまく動きません。
惜しいですか？見るところ全然ちがいますか？
後、B列に空白があったら消す。と言うところですが、
最後だけ毎回行が残ってしまっています。
現状マクロが動いた時の結果↓
A B C D E F G
1 AIU 1 1 2 1 2 AIU 1 1 2 1 3 AIU 1 1 2 1 4 AIU 1 1 2 1 5 AIU 1 1 8 1 6 AIU 1 1 2 1 7 AIU 1 1 2 1 8 AIU 1 1 2 1 9 AIU 1 1 2 1 10 AIU 1 1 2 1 11 AIU 1 5 2 1 12 AIU 1 1 5 1 13 AIU 1 1 2 1 14 AIU 1 1 4 1 15 AIU 1 1 2 1 16 AIU 1 1 2 1 17 りんご 18 りんご 19 りんご 20 りんご 21 りんご 22 ばなな 23 りんご 24 りんご 25 りんご 26 27
きっと、26行目にAIUと入力されていれば17行目から25行目がB列の空白となるので消されるように
作ってくれているんですよね。
↓このようになったらうれしいです。貼り付け元の1行目から9行目はそのまま残したいです。
A B C D E F G
1 2 3 4 2017年2月16日 5 国際部 6 7 8 9 伝票番号 個数 ・・ ・・ ・・ ・・ 10 AIU 1 1 2 1 11 AIU 1 5 2 1 12 AIU 1 1 5 1 13 AIU 1 1 2 1 14 AIU 1 1 4 1 15 AIU 1 1 2 1 16 AIU 1 1 2 1 17 18 19 20 21 22 23 24 25 26 27
（QP） 2017/02/16(木) 14:39
>QP さん
>やはり保存しないと「ﾃﾞｰﾀ抽出先のシート出荷ｽｹｼﾞｭｰﾙがが見つからないので、終了します」 >とでました。保存すればマクロが動きました。 >保存してなければ拡張子がない？から仕方ないんですかね？ >保存すればできるので保存します！
保存しないと、エクセルのWorkbookとして認識されないのですね。 保存してください。保存するファイルのファイル名が、分かっているなら、 マクロで事前に、保存することもできると思いますが。こだわります？ 保存するファイルのファイル名は、いつも同じわけじゃないですよね？ _ _ >後付けで申し訳ありませんが、 >1行目から9行目までは空白があっても動かしたくなかったです。。 >最後だけ毎回行が残ってしまっています。 どちらも、後付けですが、このぐらいなら、すぐ対応できます。 下記のコードで試してみてください。
*****************************************************************
fr = sh2.Cells(Rows.Count, "B").End(xlUp).Row
Set myRng = sh2.Range(sh2.Cells(1, "B"), sh2.Cells(fr, "B"))'■
For Each c In myRng
*****************************************************************
となっている箇所を次のように変更してください。■の1行→★の9行
*****************************************************************
fr = sh2.Cells(Rows.Count, "B").End(xlUp).Row
If fr < 10 Then Exit Sub 'B列の最終行が10より小さい場合は、終了'★★
Dim last_r As Long, last_c As Long '★
last_r = sh2.UsedRange.Item(sh2.UsedRange.Count).Row '★
last_c = sh2.UsedRange.Item(sh2.UsedRange.Count).Column '★
If last_r > fr Then '★
Set myRng = sh2.Range(sh2.Cells(fr + 1, "B"), sh2.Cells(last_r, last_c)) '★
myRng.Clear '削除（書式も）'★
End If'★
Set myRng = sh2.Range(sh2.Cells(10, "B"), sh2.Cells(fr, "B")) '★★
For Each c In myRng
*****************************************************************
>1行目から9行目までは空白があっても動かしたくなかったです。。
に対応するｺｰﾄﾞは、上記の★★が付いた行（2行分）
10の数字があるとこ！
_
_
A列は、すべて空白でしたっけ？、数字「1,2,3,…」が入ってるんでしたっけ？
（マリオ） 2017/02/16(木) 21:04
おはようございます。
何か話が良く分からない方向に行ってるけど、元々の以下の記述には何か問題があったんですか？ 私にはこの部分は特に変更する必要は無い、よく洗練された良いコードだと思うんですけど？
With Range("B1", ActiveSheet.UsedRange).Offset(9)
.Columns(.Columns.Count + 1).Formula = "=IF(OR(B10="""",B10=""伝票番号""),True,"""")"
On Error Resume Next
.Columns(.Columns.Count + 1).SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow.Delete
On Error GoTo 0
.Columns(.Columns.Count + 1).ClearContents
End With
Range("D:D,G:G,H:H,J:J,K:K").Delete Shift:=xlToLeft
マリオさん
>どちらも、後付けですが、 どちらもマリオさんの解釈に問題があっただけと思いますよ。
>With Range("B1", ActiveSheet.UsedRange).Offset(9)
一番初めからこの記述で10行目からと分かりますよね。
>.Columns(.Columns.Count + 1).Formula = "=IF(OR(B10="""",B10=""伝票番号""),True,"""")" 式を見れば一目瞭然ですが、B列には空白があって、空白のセルをTRUEにして、最後削除してます。 なので以下のコードでは、最終行がB列が空白で他の列が空白じゃないとかだと残るのが当たり前ですよね。 >fr = sh2.Cells(Rows.Count, "B").End(xlUp).Row
元のコードを無理に変えさせようとして、余計ややこしいコードになってませんか？ 少なくとも元のコードを変えさせるほどのコードには見えません。
元々はペーストでのエラー回避ですよね？
>保存してなければ拡張子がない？から仕方ないんですかね？ コピー元のブックが認識されないのは、Excelが別のインスタンスで起動しているからじゃないですか？ EXCELが2つ起動してる事ですけど、それなら当初の質問も該当してきます。 別インスタンスで保存してないブックだとAPIになると思いますので、非常に難易度が高くなるので、 先にEXCELが1つも起動していない状態で業務アプリでコピー元ブックを作成し、そのEXCELでマクロブックを開いて、 マリオさんの'----- ﾃﾞｰﾀ抽出元のシートをコピーする ------の記述を使えばコピー出来ると思います。
>保存すればできるので保存します！ もちろん保存して同じインスタンスで開けば何も問題は無いので、一番お勧めです。
（sy） 2017/02/17(金) 07:30
こんにちわ。
>マクロで事前に、保存することもできると思いますが。こだわります？ いいえ。こだわりません。
変更して頂いたｺｰﾄﾞで10行目以降からになりました！ありがとうございます。
A B C D E F G
1 2 3 4 2017年2月16日 5 国際部 6 7 8 9 伝票番号 個数 ・・ ・・ ・・ ・・ 10 AIU 1 1 2 1 11 AIU 1 5 2 1 12 AIU 1 1 5 1 13 AIU 1 1 2 1 14 AIU 1 1 4 1 15 AIU 1 1 2 1 16 AIU 1 1 2 1 17 & 18 % 19 5
前回、最終行の最後？の、ばななやリンゴが消えない。ってのは改善されました！ ありがとうございます。 ですが、A列は消えませんでした。A列の存在を伝えていなくて申し訳ありません。 （前回掲示した表にはA列を空白にしてしまっていたからですよね）
A列にはｱﾙﾌｧﾍﾞｯﾄが書いてあります。 A列に数字「1,2,3,…」と見えたのは行です。幅が近くて紛らわしかったですよね(>_<)
ｺｰﾄﾞの意味？（緑色になるやつ）までかいていただいてるので嬉しいです。
（QP） 2017/02/17(金) 17:11
Range("A1").PasteSpecial Paste:=xlPasteValues
貼り付けがうまく動く！たまに動かない。。 この曖昧になっちゃうのは、QPちゃんの記述が物足りないから、パソコンちゃんは困っちゃているですよね。
ｺｰﾄﾞが変わってしまっていても、その掲示していただいたｺｰﾄﾞがどういう意味をあらわしているのか、 調べるのも楽しい時間になっているのでマリオさんには助かっています。
同じ手順で作業していて
Range("A1").PasteSpecial Paste:=xlPasteValuesが動く時、動かない時。それはまだ不明ですが、
syさん、???さん、マリオさんには助けられています。
ありがとうございます。 （QP） 2017/02/17(金) 18:17
>QP さん >A列は消えませんでした。A列の存在を伝えていなくて申し訳ありません。 Set myRng = sh2.Range(sh2.Cells(fr + 1, "B"), sh2.Cells(last_r, last_c)) '★ このｺｰﾄﾞの「"B"」を「"A"」に変えて下さい。A列も消えます。
（マリオ） 2017/02/18(土) 00:22
>貼り付けがうまく動く！たまに動かない。。 >この曖昧になっちゃうのは、QPちゃんの記述が物足りないから、 >パソコンちゃんは困っちゃているですよね。
エクセルを開いた状態で、ファイルを生成したときと、
ファイルを生成した後、マクロのあるブックを開いたときで、
エラーが出る、出ないが分かれるのでは？？？
システム屋さんに頼んで、保存してないエクセルファイルに
出力するのではなく、
特定のファイル名で出力してもらうように改変してもらって
みてはいかがでしょう？
そうしたら、そのファイルを開くようにマクロを作ればいいと思うのですが。。。そういうことは頼めないのかなぁ。。。
とりあえず、エラーが出ないように条件分岐してみては？
貼付が出来なければ、コピー元を保存して、同じエクセルから開き直す？
Sub test()
If Application.CutCopyMode = False Then
MsgBox "貼付が出来ません。処理を中止します。"
Exit Sub
End If
With ThisWorkbook.Sheets(1)
.Range("A1").PasteSpecial Paste:=xlPasteValues
With Application.Range(.Range("B10"), .UsedRange.SpecialCells(xlCellTypeLastCell))
.UnMerge
With .Columns(1)
.Replace "伝票番号", ""
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With
.Offset(-1, -1).Resize(.Rows.Count + 1, .Columns.Count + 1) _
.Range("D:D,G:G,H:H,J:J,K:K").Delete Shift:=xlToLeft
End With
End With
End Sub
※データが既定のものか判別する部分は考慮して書いてません。
（データが10行目以降に配置されているかどうか等）
（まっつわん） 2017/02/18(土) 15:39
>システム屋さんが作ってくれたものでｽｹｼﾞｭｰﾙ表を抽出した後、 >そのExcelをﾃﾞｽｸﾄｯﾌﾟに保存するには、ファイル→名前を付けて保存→ﾏｲｺﾝﾋﾟｭｰﾀ→DL***のC→ﾕｰｻﾞ→･･･と >やらないとﾃﾞｽｸﾄｯﾌﾟに保存されないように作られている？ようです。
単純に名前を付けて保存で、ダイアログの左に出てる候補からデスクトップを選んで保存できませんか？ システムからExcelにデータが吐き出されているなら出来る筈ですけどねぇ？
何れにしても保存してから開きなおすと、普通に認識できる筈なので以下のようなコードで出来ると思います。 ボタンでマクロを起動するとの事なので、転記先シートが必ずアクティブになっているとの前提です。 転記元のブック名は Book1.xlsx にしていますので好きな名前に変えて下さい。
Option Explicit
Sub 国際パーツ確認リスト()
'シート初期化
Cells.Clear
'データのコピペ
Workbooks("Book1.xlsx").Sheets("出荷ｽｹｼﾞｭｰﾙ").Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'行削除
With Range("A1", ActiveSheet.UsedRange).Offset(9).Columns(2)
.Replace What:="伝票番号", Replacement:=""
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With
'列削除
Range("D:D,G:G,H:H,J:J,K:K").Delete Shift:=xlToLeft
End Sub
元のコードが数式を使ってるので、もし上記コードで空白行が削除されなかったら、'行削除 の部分は 元々の数式処理の記述になりますね。
ちょっと殴り書きでいい加減な記述してる箇所がありましたので修正します。 申し訳ありません。 (21:35)
（sy） 2017/02/18(土) 16:22
こんにちわ。
返信遅くなりすみません。
「"B"」を「"A"」に変更したらA列も消えました！！
最後まで親切にありがとうございました。
（まっつわん）さま、
作業時間が大幅に変わる改善ではないので、システム屋さんに
特定のファイル名で出力してもらうように変更依頼をかけないようです。。
まっつわんさんので何度か試しましたが、全部貼り付け成功しました。
ありがとうございます。
（sy）さま、
システム屋さんが作ってくれた分だけ、ダイアログの左に出てる候補からデスクトップを選んで保存しても、
デスクトップに保存されていないです。
仮にデスクトップに保存されていたとしても、QPちゃんには見えません。。
syさんに書いていただいたｺｰﾄﾞでバッチリ動きました。
ありがとうございます。
（QP） 2017/02/21(火) 15:53
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.