質問するログイン新規登録

回答編集履歴

2

コード追記

2021/04/21 08:05

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -26,7 +26,6 @@
26
26
  Sub T111()
27
27
 
28
28
  Dim wb0 As Workbook
29
-
30
29
  Dim UST1 As Long
31
30
  Dim UST2 As Long
32
31
  Dim ws0 As Worksheet, ws1 As Worksheet
@@ -48,4 +47,27 @@
48
47
  Application.CutCopyMode = False
49
48
 
50
49
  End Sub
50
+ ```
51
+
52
+ 別案
53
+ ---
54
+
55
+ SpecialCells(xlTextValues) で空白セル以外の範囲を指定できるので、それをコピーして貼り付ければループする必要はないです。
56
+
57
+ ```vba
58
+ Sub T111()
59
+
60
+ Dim ws0 As Worksheet, ws1 As Worksheet
61
+ With ThisWorkbook
62
+ Set ws0 = .Worksheets("本日")
63
+ Set ws1 = .Worksheets("test2")
64
+ End With
65
+
66
+ ws1.Range(ws1.Cells(7, 3), ws1.Cells(Rows.Count, 3).End(xlUp)) _
67
+ .SpecialCells(xlTextValues).Copy
68
+ ws0.Cells(13, 3).PasteSpecial Paste:=xlPasteValues
69
+
70
+ Application.CutCopyMode = False
71
+
72
+ End Sub
51
73
  ```

1

コード修正

2021/04/21 08:05

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -1,4 +1,4 @@
1
- With の意味が理解できいないようです。
1
+ With の意味が理解できいないようです。
2
2
  ```vba
3
3
  With Worksheets("test2")
4
4
 
@@ -39,7 +39,7 @@
39
39
  UST1 = 13
40
40
 
41
41
  For UST2 = 7 To ws1.Cells(Rows.Count, 3).End(xlUp).Row
42
- If .Cells(UST2, 3).Value <> "" Then '
42
+ If ws1.Cells(UST2, 3).Value <> "" Then '
43
43
  ws1.Cells(UST2, 3).Copy
44
44
  ws0.Cells(UST1, 3).PasteSpecial Paste:=xlPasteValues
45
45
  UST1 = UST1 + 1