質問編集履歴

2

タイトル変更

2016/08/25 08:58

投稿

morikawa0208
morikawa0208

スコア27

test CHANGED
@@ -1 +1 @@
1
- あるExcelの複数のシートから、特定の値を持つ「行」のみ別のExcelへ抽出したい
1
+ 【内容追記】あるExcelの複数のシートから、特定の値を持つ「行」のみ別のExcelへ抽出したい
test CHANGED
File without changes

1

途中経過

2016/08/25 08:58

投稿

morikawa0208
morikawa0208

スコア27

test CHANGED
File without changes
test CHANGED
@@ -41,3 +41,89 @@
41
41
 
42
42
 
43
43
  私の勉強不足によりおかしな質問をしているかもしれませんが、何卒よろしくお願いいたします。
44
+
45
+
46
+
47
+ ###途中経過
48
+
49
+ ご回答いただいた方々のおかげで、元シートをコピー後、別ブックへの書き込みは
50
+
51
+ できるようになりました。
52
+
53
+ ただ、複数行が対象となった場合に、貼付けの動作が1行の中でループしてしまいます。
54
+
55
+ (言葉で伝わるか微妙なところですが)
56
+
57
+
58
+
59
+ 98%回答いただいたコードですが以下のコードです。
60
+
61
+ 【やりたいこと】
62
+
63
+ 対象となった行を別ブックに貼付け、次の対象となった行はその下に貼付ける 以後繰り返し
64
+
65
+ ```ここに言語を入力
66
+
67
+ Sub 書きかけ()
68
+
69
+
70
+
71
+
72
+
73
+ Dim i As Integer
74
+
75
+ i = 1
76
+
77
+
78
+
79
+ Dim sht As Worksheet
80
+
81
+ Dim rng As Range
82
+
83
+ Dim lastRow As Long
84
+
85
+
86
+
87
+ '現在のブック内にあるすべてのシートをループ処理
88
+
89
+ For Each sht In ActiveWorkbook.Worksheets
90
+
91
+ '対象シート内のA列先頭からA列最終データ行までをループ処理
92
+
93
+ For Each rng In sht.Range(sht.Cells(1, 1), sht.Cells(sht.Rows.Count, 1).End(xlUp))
94
+
95
+ 'A列が1なら、その行をコピー
96
+
97
+ If sht.Cells(rng.Row, 1) = 1 Then
98
+
99
+ sht.Rows(rng.Row).Copy
100
+
101
+
102
+
103
+ 'DBブックを選択し、一番下の行を選択
104
+
105
+ Windows("VBAテスト.xlsx").Activate
106
+
107
+ lastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1
108
+
109
+
110
+
111
+ '値で貼り付け
112
+
113
+ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
114
+
115
+ :=False, Transpose:=False
116
+
117
+ End If
118
+
119
+
120
+
121
+ Next rng
122
+
123
+ Next sht
124
+
125
+
126
+
127
+ End Sub
128
+
129
+ ```