回答編集履歴

1

追記

2019/07/31 10:04

投稿

mattuwan
mattuwan

スコア2136

test CHANGED
@@ -11,3 +11,115 @@
11
11
 
12
12
 
13
13
  こんな説明でわかりますか?
14
+
15
+
16
+
17
+ その後、質問者さんの反応がないけど、、、、
18
+
19
+ ループして最大値を探すのは、If~Then~や変数の使い方も含めて、基本中の基本なので、
20
+
21
+ 自分で思いついて、自分で書けるようになりましょう。
22
+
23
+ この辺は経験なので、試験用の勉強だけでは辛いかもです。
24
+
25
+
26
+
27
+ 他の方も書いておられますが、僕が書いたらこんな感じ、、、、
28
+
29
+
30
+
31
+ ```ExcelVBA
32
+
33
+ Sub test1()
34
+
35
+ Dim rngTable As Range '表のセル範囲(シート上の使用している範囲)
36
+
37
+ Dim rngTarget As Range 'コピーしたいセル範囲
38
+
39
+ Dim c As Range '各セル
40
+
41
+ Dim ix As Long '行番号
42
+
43
+ Dim ixMax As Long '最大データ行番号
44
+
45
+
46
+
47
+ '表のセル範囲を取得して変数に記録
48
+
49
+ Set rngTable = Sheets("Sheet1").UsedRange
50
+
51
+
52
+
53
+ '列毎に繰り返し見て行き最大データ行を調べる
54
+
55
+ For Each c In rngTable.Columns
56
+
57
+ ix = c.Cells(c.Cells.Count + 1, 1).End(xlUp).Row
58
+
59
+ If ixMax < x Then ixMax = ix
60
+
61
+ Next
62
+
63
+
64
+
65
+ '取得した最大行番号でコピー
66
+
67
+ With rngTable
68
+
69
+ .Range(.Cells(2, 1), .Cells(ixMax + 1, .Columns.Count)).Copy
70
+
71
+ End With
72
+
73
+
74
+
75
+ '貼付
76
+
77
+ With Sheets("Sheet2")
78
+
79
+ .Paste .Range("A2")
80
+
81
+ End With
82
+
83
+ End Sub
84
+
85
+ ```
86
+
87
+
88
+
89
+ 自分でループ処理を書かなければ、こんな感じですかね。。。
90
+
91
+ ```ExcelVBA
92
+
93
+ Sub test2()
94
+
95
+ Dim rngTable As Range: Set rngTable = ActiveSheet.UsedRange
96
+
97
+ Dim rngBottom As Range
98
+
99
+
100
+
101
+ With rngTable
102
+
103
+ With .SpecialCells(xlCellTypeConstants)
104
+
105
+ Set rngBottom = .Areas(.Areas.Count).EntireRow
106
+
107
+ End With
108
+
109
+ Set rngBottom = Intersect(.Cells, rngBottom)
110
+
111
+ End With
112
+
113
+ Application.Range(rngTable.Rows(2), rngBottom).Select
114
+
115
+ End Sub
116
+
117
+ ```
118
+
119
+ 勘で書いたので、もしかしたら不具合があるかもです。
120
+
121
+ シート上の値の配置パターンにより、意図しない結果になる場合は、
122
+
123
+ その配置のパターンをお教え下さい。
124
+
125
+ 暇があれば対応策を考えてみます。