[發問] 請問「最後一行資料 下拉複製」到新的一行，如何寫成巨集或VB呢？

cslu37

請問各位大大：
因為每日都要更新一筆資料，所以都是「選取」「最後一行」，再拖曳向下拉(複製)到新的一行。
如圖：複製5月2日的「A7:E7」，然後向下拉，變成多一行 5月3日的「A8:E8」。
            且每日向下新增一行5月4日「A9:E9」、5月5日「A10:E10」、5月6日「A11:E11」........

請各位大大幫忙，這樣的動作，要如何寫成巨集呢？還是需要用VB寫呢？

GBKEE

回復 1# cslu37
試試看
這工作表 Sheet模組 的程式碼

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range
   
4.     Set Rng = Range("A2:E2")
   
5.     If Rng.End(xlDown).Row <> Rows.Count Then
   
6.         '工作表的總列數: Rows.Count 2003=65536,2010=1048576
   
7.         Set Rng = Range(Rng, Rng.End(xlDown))
   
8.         '"A2:E2" 往下延伸到最後又資料的位置
   
9.     End If
   
10.     'Range.AutoFill 方法 可參說明
    
11.     With Rng
    
12.         .AutoFill Destination:=.Rows("1:" & .Rows.Count + 1), Type:=xlFillDefault
    
13.         '.Rows("1:" & .Rows.Count + 1)  Rng的列數+1的範圍
    
14.     End With
    
15.    
    
16. End Sub

複製代碼

cslu37

回復 2# GBKEE


    謝謝GBKEE大大喔:loveliness: ！！

cslu37

回復 2# GBKEE


請問 GBKEE 大大：
目前遇到的問題...
就是Excel共有三個Sheet(Sheet1、Sheet2、Sheet3)，但三個Sheet現有的行數都不同，需要下拉的欄位也不同，
想要做一個按鈕，按一下按鈕，就可以一次拖曳下拉三個Sheet最後一行的資料呢?
懇請GBKEE大大指導！！謝謝您！！

cslu37

回復 2# GBKEE

感謝GBKEE大大，附上檔案，麻煩GBKEE大大指導！謝謝您！！

工作表1→A欄~E欄，從14行 拖曳下拉到15行。
工作表2→A欄~G欄，從27行 拖曳下拉到28行。
工作表3→A欄~I欄，從41行 拖曳下拉到42行。

拖曳下拉20190409.rar (14.41 KB)

下載次數: 6

2019-5-9 09:19

GBKEE

回復 5# cslu37

依你附檔內容所寫程式碼
試試看

1. Option Explicit
   
2. Dim Rng As Range
   
3. Sub Ex_下拉1()
   
4.     Dim i As Integer, AR(), E As Variant
   
5.     AR = Array(工作表2, 工作表3)
   
6.     '***子程式的方呆措施*****
   
7.     For Each E In AR  '迴圈 e : 依序傳回 陣列內的工作表物件
   
8.         If TypeName(E) <> "Worksheet" Then MsgBox "陣列元素需是   Worksheet 物件": End
   
9.     Next
   
10.     '*************************
    
11.     With Sheets("工作表1")
    
12.         Set Rng = .Range("a3", "e" & .Range("a2").End(xlDown).Row)
    
13.         If .Range("a2").End(xlDown).Row = Rows.Count Then
    
14.             Set Rng = .Range("A3")   '工作表1尚未有資料
    
15.             Rng = Date
    
16.             For i = 2 To 5  '迴圈:依序輸入資料
    
17.                 '**不知公式為和**
    
18.                 Rng.Cells(1, i) = i
    
19.             Next
    
20.         Else
    
21.             '工作表1已有資料 , 用範圍下拉方法
    
22.             If Rng.Rows.Count = 1 Then ''**因下拉的範圍列數只有一列***
    
23.                 .Select
    
24.                 Rng.Cells(2, 1).Activate
    
25.                 MsgBox "下拉的範圍列數只有一列" & vbLf & "請自行輸入" & Rng.Offset(1).Address & "的數值...."
    
26.                 End
    
27.                
    
28.             End If
    
29.             Rng.AutoFill Destination:=Rng.Rows("1:" & Rng.Rows.Count + 1), Type:=xlFillDefault
    
30.             Set Rng = Rng.Cells(Rng.Rows.Count + 1, 1) 'A欄範圍內最後的日期
    
31.         End If
    
32.     End With
    
33.     Ex_下拉2 AR  '呼叫 子程序
    
34. End Sub
    
35. Sub Ex_下拉2(Sh As Variant)  '子程序 需傳遞參數(陣列(工作表物件))
    
36.     Dim xRng As Range, AR(), E As Variant
    
37.     For Each E In Sh  '迴圈 e : 依序傳回 陣列內的工作表物件
    
38.         If E.Name = "工作表2" Then
    
39.             '資料2-3 資料2-4 資料2-5 資料2-6 的公式
    
40.             AR = Array("=rc[-2]*1+rC[-1]*1", "=rC[-3]*rC[-2]+rC[-1]", "=rC[-3]*rC[-2]-rc[-1]", "=rc[-3]+rc[-2]-rc[-1]")
    
41.         ElseIf E.Name = "工作表3" Then
    
42.             '資料3-3 資料3-4 資料3-5 資料3-6 資料3-7 資料3-8  '的公式
    
43.             AR = Array("=rc[-2]+rc[-1]", "=rc[-1]-rc[-2]", "=rc[-2]+rc[-1]", "=rc[-2]*rc[-1]", "=rc[-2]+rc[-1]", "=rc[-2]-rc[-1]")
    
44.         Else
    
45.             MsgBox "工作表錯誤 程式關閉": End
    
46.         End If
    
47.         Set xRng = E.Range("A:A").Find(Rng.Text, LookIn:=xlValues) '尋找工作表1A欄範圍內最後的日期
    
48.         If xRng Is Nothing Then   '沒找到
    
49.             Set xRng = E.Range("A" & Rows.Count).End(xlUp).Offset(1)
    
50.             '設為A欄範圍內最後的日期的下一列位
    
51.         Else
    
52.             If xRng.Range("A2") <> "" Then  '找到 且 下一列位<>""
    
53.                 With xRng
    
54.                     Range(.Cells(2, 1), .Range("A2").End(xlToRight).End(xlDown)) = ""
    
55.                     '清除下一列位後的資料
    
56.                 End With
    
57.             End If
    
58.         End If
    
59.         xRng.Resize(, 3).Value = Rng.Resize(, 3).Value  '給上工作表下拉A:C的資料
    
60.         With xRng.Cells(1, 4).Resize(, UBound(AR) + 1)
    
61.             .Cells = AR '給上工作表2,工作表3:C後資料的公式
    
62.             '***** 如上列 給上工作表2,工作表3:C後資料的公式 正確
    
63.            .Cells = .Value '***** 可用下列此程式碼將處存格的公式轉為值
    
64.          '*************************************************
    
65.         End With
    
66.     Next
    
67. End Sub

複製代碼

hcm19522

https://blog.xuite.net/hcm19522/twblog/587551775

cslu37

回復  cslu37
試試看
這工作表 Sheet模組 的程式碼
GBKEE 發表於 2019-5-5 16:15

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range
   
4.     Set Rng = Range("A2:E2")
   
5.     If Rng.End(xlDown).Row <> Rows.Count Then
   
6.         '工作表的總列數: Rows.Count 2003=65536,2010=1048576
   
7.         Set Rng = Range(Rng, Rng.End(xlDown))
   
8.         '"A2:E2" 往下延伸到最後又資料的位置
   
9.     End If
   
10.     'Range.AutoFill 方法 可參說明
    
11.     With Rng
    
12.         .AutoFill Destination:=.Rows("1:" & .Rows.Count + 1), Type:=xlFillDefault
    
13.         '.Rows("1:" & .Rows.Count + 1)  Rng的列數+1的範圍
    
14.     End With
    
15.    
    
16. End Sub

複製代碼

GBKEE大大您好：
    我嘗試著改成拉到下一行後，再將整行改成"值"，但爬文爬了一整晚，也嘗試修改...但一直出現錯誤訊息>"<
    請大大指導，要在哪加上value，才能在下拉後  再改成"值"呢？
    感謝GBKEE大大！！

cslu37

回復 7# hcm19522


  謝謝 hcm19522 的分享！！
  只是遇到一個問題...就是...日期會自動將空的日期自動補上 並連續...
  例如：因為六日不需要更新，所以5/10 接著就是 5/13，但G2顯示5/13後，會自動將5/11、5/12也填入...
              變成5/10
                      5/11
                      5/12
                      5/13
    請問如何才能將週末扣除呢，懇請hcm19522大大指導，謝謝您！！

hcm19522

https://blog.xuite.net/hcm19522/twblog/587574650