我知道這個論壇上有很多這樣的問題。然而，他們都沒有給出令人滿意的答復。
我需要一個宏，它將從不同作業表中的 3 個單元格中復制值（都在同一個 Excel 檔案中）：E6（實際上它是一個包含列 EFG 的合并單元格）、E(FG)5 和 E21。然后將這些值粘貼到新作業表中的 A、B 和 C 列中。有 2 個問題無法讓我用傳統的復制單元格值代碼或本論壇其他執行緒中的答案解決此問題：
合并了 3 個單元格。不同時期的作業表數量可能會有所不同，并且它們的名稱也可能會更改。這是我為另一個類似問題找到的代碼：
Sub CopyToMaster()
ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
Worksheets(i).Activate
Range("E6").Select
Selection.Copy
Sheets("Master").Activate
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial
Next i
End Sub
源資料（這是源資料，我用黃色 3 個單元格標記了值，我需要復制）：
需要的結果（這是預期的結果，以前黃色標記的單元格中的每個應粘貼在相應的列中）：
謝謝你的幫助。
uj5u.com熱心網友回復：
請測驗下一個（作業）代碼。它應該比你的更快，而不是使用剪貼板。您必須知道合并范圍的值保存在其左上角單元格中。因此，具有單行的范圍，嘗試提取第一個邊緣單元格單元格的值就足夠了：
Sub CopyToMasterWorking()
Dim ws As Worksheet, wsM As Worksheet, lastR As Long, i As Long
Set wsM = Worksheets("Master")
wsM.UsedRange.Resize(wsM.UsedRange.rows.count - 1).Offset(1).ClearContents 'clear everything, except headers
For Each ws In ActiveWorkbook.Worksheets
If ws.name <> wsM.name Then
lastR = wsM.UsedRange.SpecialCells(xlCellTypeLastCell).row 1
wsM.Range("A" & lastR).Value = ws.Range("E6").Value
wsM.Range("B" & lastR).Value = ws.Range("E5").Value
wsM.Range("C" & lastR).Value = ws.Range("E21").Value
wsM.Range("D" & lastR).Value = ws.name 'you may comment this line if not necessary...
End If
Next ws
End Sub
我認為有一點可追溯性會很好，我的意思是知道資料來自哪張表（每行）。如果您不需要它，您可以注釋作業表之間迭代的最后一行代碼。
在開始處理之前，代碼還會清除“主”表中的所有內容，但標題除外。如果您需要在現有資料的末尾添加，您也必須注釋該行。
請在測驗后發送一些反饋。如果有什么不夠清楚，請不要猶豫，要求澄清......
uj5u.com熱心網友回復：
我認為您唯一的問題是復制合并單元格范圍，對嗎？這顯示了如何將合并單元格范圍復制到 1) 相同大小的范圍 2) 單個單元格 3) 不同大小的范圍：
Option Explicit
Sub sub1()
Dim variant1
Cells.Delete
' define a merged-cell range and populate:
Range("b2:c3").MergeCells = True
Range("b2:c3") = " B2:C3 "
' to copy to a like-sized merged-cell range:
Range("b5:c6").MergeCells = True
Range("b2:c3").Copy Range("b5:c6")
' to copy to a single cell
variant1 = Range("b2:c3").Value
Range("b8").Value = variant1
' to copy to a different-sized merged-cell range:
Range("b10:d12").MergeCells = True
variant1 = Range("b2:c3").Value
Range("b10:d12").Value = variant1
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/515450.html
標籤：擅长vba