こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

【VBA】別々のシートに列ごとコピーしていきたい

エクセルVBA初心者です

以下のような表を、地区別にわけられたシートで、種別を選んで貼り付けていきたいのですが

地区種別
1大阪金
2東京銀
3名古屋銀
4大阪金
5大阪銅
6名古屋銅
7東京金
8名古屋金
9大阪銅
金と銀のみ、地区に分けられたシートに貼り付け

シート【大阪】
1大阪金
4大阪金

シート【東京】
2東京銀
7東京金

シート【名古屋】
3名古屋銀
8名古屋金

以下のVBAを加工してみましたが組んでみましたがうまくいきません
どうかご教示のほどよろしくお願いします


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

Public Sub cptest()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rng As Range
Dim cel As Range
Dim stcrng As New Collection
Dim lastRow As Integer
Dim cnt As Integer
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")
lastRow = Range("G65535").End(xlUp).Row
Set rng = sht1.Range("G1:G" & lastRow)
For Each cel In rng
If cel.Value = "あり" Then
Set cel = sht1.Range(cel.Offset(0, -4), cel.Offset(0, -1))
stcrng.Add cel
End If
Next

sht2.Cells.Clear
cnt = 0
Set rng = sht2.Range("A1")
For Each cel In stcrng
cel.Copy
rng.Offset(cnt, 0).PasteSpecial
rng.Offset(cnt, 4).Value = "_"
cnt = cnt + 1
Next
Application.CutCopyMode = False
End Sub

投稿日時 - 2012-07-11 18:08:51

QNo.7584619

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

提示ソースを出来るだけ活かそうと思いましたが、いまいち意図がわからず挫折しました。
「大阪」「東京」「名古屋」と言うシートが存在する前提のマクロです。

Sub Sample()
  sCity = Split("大阪,東京,名古屋", ",")
  Columns("G:G").Select
  Selection.AutoFilter
  For i = 0 To UBound(sCity)
    Range("G:G").AutoFilter Field:=1, Criteria1:="=*" & sCity(i) & "*", Operator:=xlAnd, Criteria2:="<>*銅"
    Range("G:G").CurrentRegion.SpecialCells(xlVisible).Copy Worksheets(sCity(i)).Range("G1")
  Next i
  Selection.AutoFilter
End Sub

大変申し訳ございませんが、この投稿に添付された画像や動画などは、「BIGLOBEなんでも相談室」ではご覧いただくことができません。 OKWAVEよりご覧ください。

マルチメディア機能とは?

投稿日時 - 2012-07-11 18:59:39

あなたにオススメの質問