回答編集履歴

2

コード追記

2021/04/21 08:05

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -54,8 +54,6 @@
54
54
 
55
55
  Dim wb0 As Workbook
56
56
 
57
-
58
-
59
57
  Dim UST1 As Long
60
58
 
61
59
  Dim UST2 As Long
@@ -99,3 +97,49 @@
99
97
  End Sub
100
98
 
101
99
  ```
100
+
101
+
102
+
103
+ 別案
104
+
105
+ ---
106
+
107
+
108
+
109
+ SpecialCells(xlTextValues) で空白セル以外の範囲を指定できるので、それをコピーして貼り付ければループする必要はないです。
110
+
111
+
112
+
113
+ ```vba
114
+
115
+ Sub T111()
116
+
117
+
118
+
119
+ Dim ws0 As Worksheet, ws1 As Worksheet
120
+
121
+ With ThisWorkbook
122
+
123
+ Set ws0 = .Worksheets("本日")
124
+
125
+ Set ws1 = .Worksheets("test2")
126
+
127
+ End With
128
+
129
+
130
+
131
+ ws1.Range(ws1.Cells(7, 3), ws1.Cells(Rows.Count, 3).End(xlUp)) _
132
+
133
+ .SpecialCells(xlTextValues).Copy
134
+
135
+ ws0.Cells(13, 3).PasteSpecial Paste:=xlPasteValues
136
+
137
+
138
+
139
+ Application.CutCopyMode = False
140
+
141
+
142
+
143
+ End Sub
144
+
145
+ ```

1

コード修正

2021/04/21 08:05

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -1,4 +1,4 @@
1
- With の意味が理解できいないようです。
1
+ With の意味が理解できいないようです。
2
2
 
3
3
  ```vba
4
4
 
@@ -80,7 +80,7 @@
80
80
 
81
81
  For UST2 = 7 To ws1.Cells(Rows.Count, 3).End(xlUp).Row
82
82
 
83
- If .Cells(UST2, 3).Value <> "" Then '
83
+ If ws1.Cells(UST2, 3).Value <> "" Then '
84
84
 
85
85
  ws1.Cells(UST2, 3).Copy
86
86