Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


33366 / 76738 ←次へ | 前へ→

【48594】Re:シートコピーの編集方法で悩んでいます。
発言  ウッシ  - 07/4/24(火) 10:39 -

引用なし
パスワード
   こんにちは

Sheet1のB2に抽出年月、B4以下にデータとして、Sheet2に抽出するなら、

Sub test()
  Dim r    As Range
  Dim c    As Range
  Dim v()   As String
  Dim i    As Long
  With Worksheets("Sheet1")
    With .Range("B4", .Range("B65536").End(xlUp))
      .AutoFilter Field:=1, _
        Criteria1:=.Parent.Range("B2").Value
      For Each r In .SpecialCells(xlCellTypeVisible)
        If r.Row > 4 Then
          ReDim Preserve v(0 To i)
          v(i) = r(0, 1).Address
          i = i + 1
        End If
      Next
      If .Parent.AutoFilterMode = True Then _
          .Parent.AutoFilterMode = False
      On Error Resume Next
      For i = LBound(v) To UBound(v)
        Set c = .Find("コード*", .Parent.Range(v(i)), xlValues, xlPart)
        If Not c Is Nothing Then
          .Parent.Range(v(i), c).Copy _
            Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1)
        End If
      Next
      On Error GoTo 0
    End With
  End With
  Erase v
End Sub

データが無い場合等のエラー処理はご自分で追加してみて下さい。
0 hits

【48504】シートコピーの編集方法で悩んでいます。 質問(煮詰まった) 07/4/19(木) 18:09 質問
【48511】Re:シートコピーの編集方法で悩んでいます。 ウッシ 07/4/20(金) 10:20 発言
【48516】Re:シートコピーの編集方法で悩んでいます。 質問(煮詰まった) 07/4/20(金) 11:47 質問
【48519】Re:シートコピーの編集方法で悩んでいます。 ウッシ 07/4/20(金) 12:25 発言
【48522】Re:シートコピーの編集方法で悩んでいます。 質問(煮詰まった) 07/4/20(金) 13:14 発言
【48526】Re:シートコピーの編集方法で悩んでいます。 ウッシ 07/4/20(金) 14:02 発言
【48530】Re:シートコピーの編集方法で悩んでいます。 ウッシ 07/4/20(金) 15:43 発言
【48592】Re:シートコピーの編集方法で悩んでいます。 質問(煮詰まった) 07/4/24(火) 10:16 発言
【48594】Re:シートコピーの編集方法で悩んでいます。 ウッシ 07/4/24(火) 10:39 発言
【48600】Re:シートコピーの編集方法で悩んでいます。 質問(煮詰まった) 07/4/24(火) 16:28 質問
【48602】Re:シートコピーの編集方法で悩んでいます。 ウッシ 07/4/24(火) 16:53 発言

33366 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free