| |
お世話になっています。
Statis さんに教えていただいたソースでばっちりだったのですが、
sheet1の元表のデータが一件だけだと以下のエラーが出てしまいました。
（デバック：上部※がついている2行）
実行時エラー'1004'：
コピー領域と貼り付け領域の形が違うため、情報を貼り付けることができません。情報を貼り付けるには、次のいずれかの操作を行ってください。
1つのセルをクリックし、貼り付けてみてください。
貼り付け元の形を確かめ、適切な範囲を選択したあと、貼り付けてみてください。
Sub test_1()
Dim Ws As Worksheet, Fi As Range, R As Range, C As Range, Ad As String
Set Ws = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
.Columns(1).AdvancedFilter xlFilterInPlace, , , True
※ .Range("A2", .Range("A65536").End(xlUp)) _
※ .SpecialCells(xlCellTypeVisible).Copy Ws.Range("E14")
.ShowAllData
Set R = Ws.Range("E14", Ws.Range("E65536").End(xlUp))
For Each C In R
Set Fi = .Columns(1).Find(C.Value, , xlValues, xlWhole)
If Not Fi Is Nothing Then
Ad = Fi.Address
Do
Set Fi = .Columns(1).FindNext(Fi)
Fi.Offset(, 1).Resize(, 4).Copy
C.Offset(, 1).PasteSpecial xlPasteValues, xlPasteSpecialOperationAdd
Loop Until Ad = Fi.Address
End If
Set Fi = Nothing
Next C
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
Set R = Nothing: Set Ws = Nothing
End Sub
「On Error GoTo」でsheet1一行分の各セルの値をsheet2の対応セルに代入
していこうとしたのですが、なぜかコンパイルエラーが出てしまいました。
一行の場合はエラーを出さずにその一行を表示させる処理にしたいのですが何かいい方法はありますでしょうか？
教えてください！！
|
|
ゆり
- 05/10/17(月) 16:26 -
