- 帖子
- 57
- 主題
- 21
- 精華
- 0
- 積分
- 83
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2007
- 閱讀權限
- 20
- 註冊時間
- 2015-9-18
- 最後登錄
- 2022-9-13
|
回復 9# lpk187
我試過了!可以但有一個地方會錯誤,第一次資料轉出可以,再按第二次他會出現下圖
- Sub Workbook_Open2()
- Dim xlPath As Variant, Ro As Integer
- Dim xlFilea, xlFileb, arra, arrb
- xlPath = ThisWorkbook.Path & "\"
- xlFilea = ("B.xlsx")
- xlFileb = ("C.xlsx")
- arra = Sheets("工作表1").Range("A1:F1")
- arrb = Sheets("工作表1").Range("A2:F2")
- Workbooks.Open (xlPath & xlFilea)
- With Workbooks(xlFilea).Worksheets("工作表1")
- Set da = .Columns(1).Find(arra(1, 1), , , , , 2)
- If Not da Is Nothing Then GoTo 10
- Ro = .Cells(65535, 1).End(xlUp).Row + 1
-
- .Cells(Ro, 1).Resize(UBound(arra), UBound(arra, 2)) = arra
- End With
- 10:
- Workbooks(xlFilea).Close True
- Workbooks.Open (xlPath & xlFileb)
- With Workbooks(xlFileb).Worksheets("工作表1")
- Set da = .Columns(1).Find(arrb(1, 1), , , , , 2)
- If Not da Is Nothing Then GoTo 10
- Ro = .Cells(65535, 1).End(xlUp).Row + 1
- .Cells(Ro, 1).Resize(UBound(arrb), UBound(arrb, 2)) = arrb
- End With
- 20:
- Workbooks(xlFileb).Close True
- End Sub
複製代碼 另一方面如果傳送方式變成如下圖
c.xlsx會有函數去計算數值,可以跳格傳送嗎
|
|