回答受付が終了しました

VBAのコードについて教えてください。 下記のようなExcelシートがあります。

VBAのコードについて教えてください。 下記のようなExcelシートがあります。 A列の●がある、A1~D3をコピーするコードの書き方を教えていただきたいですm(__)m _____A______B _______C______D 1____●____りんご_いちご_メロン 2____●____りんご_いちご_メロン 3____●____りんご_いちご_メロン 4__________りんご_いちご_メロン

Visual Basic | Excel45閲覧xmlns="http://www.w3.org/2000/svg">500

回答(6件)

0

すでに沢山の回答がありますが 作ったのでマクロお見せします。(笑) >A列の●がある、A1~D3をコピーする コピーした後の出力範囲が書かれてないので 皆さんと同じF列へ貼り付けしてます。 では頑張ってください。 Sub Sample01() Dim Check As Long Dim ARows As Long: ARows = Cells(Rows.Count, 1).End(xlUp).Row Dim WF As WorksheetFunction: Set WF = WorksheetFunction Dim A As Integer: A = Range("A:A").Column Dim B As Integer: B = Range("B:B").Column Dim D As Integer: D = Range("D:D").Column Dim F As Integer: F = Range("F:F").Column Dim i As Long For i = 1 To ARows Check = WF.CountIf(Cells(i, 1), "●") If Check = 1 Then Range(Cells(i, A), Cells(i, D)).Copy Cells(i, F) '●抜き範囲B1~D3 'Range(Cells(i, B), Cells(i, D)).Copy Cells(i, F) End If Next i End Sub

0

A列が空白か●しかないのであれば、2行で済みますね。 F列へコピーしてます。 Sub 例文() On Error Resume Next Intersect(Range("A:D"), Range("A:A").SpecialCells(xlCellTypeConstants).EntireRow).Copy Range("F1") End Sub

0

オートフィルタ結果をSheet2のA1にコピる方法です。 Sub test() Rows(1).Insert With Range("A1").CurrentRegion .AutoFilter Field:=1, Criteria1:="●" .Resize(.Rows.Count - 1).Offset(1).Copy Sheets("Sheet2").Range("A1") Rows(1).Delete End With End Sub E列以降も入力があるけどD列までが希望というならば、 .Resize(.Rows.Count - 1).Offset(1).Copy Sheets("Sheet2").Range("A1") ↓ Intersect(.Resize(.Rows.Count - 1).Offset(1), Range("A:D")).Copy Sheets("Sheet2").Range("A1") に変えるといいです。

0

コピー先が書いていないので適当ですがこんな感じです Sub Sample() Dim i For i = 1 To 4 If Cells(i, 1) = "●" Then Range("A" & i & ":D" & i).Copy Range("F" & i) End If Next i End Sub

0

こういう事ですか? Sub jgjri() Dim i As Long Dim rng As Range For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Range("A" & i) = "●" Then If rng Is Nothing Then Set rng = Range("A" & i & ":D" & i) Else Set rng = Union(rng, Range("A" & i & ":D" & i)) End If End If Next i rng.Copy Range("F1") 'コピー先セル End Sub