把一個表格中選定的行點擊觸發鈕后可以通過設計的選項框里的選項復制到另一個表格中的不同的sheet中，因為表格很多翻來翻去很容易出錯，所以就想要編個宏。不要復制黏貼。
uj5u.com熱心網友回復：
先錄制一個手工復制粘貼的宏（得到一個方法），然后將你需要用選項選擇的部分改為方法的引數，
按鈕事件中呼叫這個方法。
uj5u.com熱心網友回復：
重點不是復制。。是如何黏貼到另一個作業表中的不同sheet里。。。手動黏貼翻來翻去很復雜的所以想有沒有更簡單，可以有個選項框啊~選擇哪個作業表的檔案名，就可以粘到里面去。。不用翻來翻去。。有么。。。uj5u.com熱心網友回復：
你可以新建個工具列，工具列加下拉框，把每個sheet的名字加到下拉框里，粘貼的時候從下拉框里選sheet。uj5u.com熱心網友回復：
是不是打開后還是需要黏貼的操作，能不能把在選擇sheet確認的同時直接黏貼在那個表格中？省去打開黏貼的操作？主要就是想省去excel表之間的轉換uj5u.com熱心網友回復：
可以：Private Sub test()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Rng As Range
Set s1 = ThisWorkbook.Worksheets("sheet1")
Set Rng = Selection
Rng.Copy
Set s2 = ThisWorkbook.Worksheets("sheet2")
s2.Activate
s2.Paste
s1.Activate
End Sub
uj5u.com熱心網友回復：
可以指定粘貼到哪個單元：Private Sub test()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Rng As Range
Set s1 = ThisWorkbook.Worksheets("sheet1")
Set Rng = Selection
Rng.Copy
Set s2 = ThisWorkbook.Worksheets("sheet2")
s2.Activate
Set Rng = s2.Cells(1, 1)
Rng.Activate
s2.Paste
s1.Activate
End Sub
uj5u.com熱心網友回復：
6L代碼有點問題：Private Sub test()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Rng As Range
Set s1 = ThisWorkbook.Worksheets("sheet1")
Set Rng = Selection
Rng.Copy
Set s2 = ThisWorkbook.Worksheets("sheet2")
s2.Activate
s2.Cells(20, 4).Select
s2.Paste
s1.Activate
End Sub
選擇區必須是方形區域，不要選擇整行或整列
uj5u.com熱心網友回復：
這是之前人家幫我寫的代碼，只能黏貼到同一個表里，想把紅字部分改成復制到另一個表里的不同sheets里（大概有27個sheets），能人工選擇確認所要的sheet后直接就黏貼到那個sheet里么？
Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
activesheetname = ActiveSheet.Name
temp1 = ActiveCell.Value
temprow1 = ActiveCell.Row
temp = InputBox("確認值", "數值", temp1)
If temp = temp1 Then
Sheets(activesheetname).Rows(temprow1 & ":" & temprow1).Select
Selection.Copy
tepmrowA = 1
Sheets("need").Select
again1:
If Sheets("need").Cells(tepmrowA, 1).Value = "" Then
Sheets("need").Cells(tepmrowA, 1).Activate
ActiveSheet.Paste
Else
tepmrowA = tepmrowA + 1
GoTo again1
End If
Sheets(activesheetname).Select
Application.CutCopyMode = False
End If
End Sub
uj5u.com熱心網友回復：
If temp = temp1 Then
Sheets(activesheetname).Rows(temprow1 & ":" & temprow1).Select
Selection.Copy
Dim i As Long
For i = 1 To Sheets.Count
If Sheets(i).Name <> activesheetname Then
tepmrowA = 1
Sheets(i).Select
again1:
If Sheets(i).Cells(tepmrowA, 1).Value = "" Then
Sheets(i).Cells(tepmrowA, 1).Activate
ActiveSheet.Paste
Else
tepmrowA = tepmrowA + 1
GoTo again1
End If
End If
Next
Sheets(activesheetname).Select
Application.CutCopyMode = False
End If
uj5u.com熱心網友回復：
xlbook.Worksheets("Sheet2").Cells(i, j) = xlbook.Worksheets("Sheet1").Cells(i, j)
加上2個回圈，搞定
uj5u.com熱心網友回復：
加一個 Sheets 的回圈就可以了。列回圈不如整行復制效率高。
uj5u.com熱心網友回復：
那就先錄制一個宏看看代碼, 精簡一下, 修改一下也就差不多了.
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/155950.html
標籤：VBA
上一篇：rs.addnew報錯