dポイントプレゼントキャンペーン実施中!

A列に0200と記載された行をコピーして別シートに貼り付けたいのですが、どれだけ調べてもコードがわかりません。
教えていただけますと助かります。

A 回答 (4件)

こんばんは!



元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行で、データは2行目以降にあるとします。
一例です。標準モジュールにしてください。

Sub Sample1()
Dim wS As Worksheet

 Set wS = Worksheets("Sheet2")
  With Worksheets("Sheet1")
   .Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:="0200"
    If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
     .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
    End If
     .AutoFilterMode = False
  End With
   wS.Activate
End Sub

※ 細かいエラー処理はしていません。m(_ _)m
    • good
    • 1

マクロの記録で、こんなのはできます。


Sheet1から、Sheet3に貼付です。
Sheet1のA列のデータのある先頭行に、列名のようなのがあるとして、です。

Sub Macro1()
Sheets("Sheet1").Select
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:="0200"
Cells.Copy
Sheets("Sheet3").Select
Cells.Select
ActiveSheet.Paste
r = Range("A1").End(xlDown).Row - 1
Rows("1:" & r).Delete Shift:=xlUp
Sheets("Sheet1").Select
ActiveSheet.Range("$A$6:$A$58").AutoFilter Field:=1
Application.CutCopyMode = False
End Sub
    • good
    • 0

iCntをインクリメントしてませんでした…


Loopの前にiCnt=iCnt+1を入れて下さい。
    • good
    • 0

こんな感じでしょうか。


スマフォでポチポチしてみただけなので動かしていないです。
不備がありましたら済みません。

Dim iCnt As Integer
iCnt =1

‘セルがブランクになるまでA列を検索
Do While ActiveSheet.Cells(iCnt, 1).Text=“”
‘セルの値が0200だったら
 If ActiveSheet.Cells(iCnt, 1).Text=“0200” Then
‘ヒットした行をコピーして、別シートのどこかの行に全貼り付け
ActiveSheet.Rows(iCnt).Copy
別シート.Rows(どこか).PasteSpecial Paste:=xlPasteAll
End If
Loop
    • good
    • 3

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A