我正在撰寫一個宏，它在給定的命名范圍內回圈遍歷行，復制每一行，然后將它們粘貼到另一個作業簿中。由于格式原因，我無法復制整個范圍。包含內容的行數會發生變化，因為宏還會在檔案串列中回圈以從中提取這些值。
我創建了一個計數器變數 i，它從 i=1 開始。我想要做的是讓 VBA 首先查看命名范圍，然后選擇其中的第 1 行。然后如果它包含內容，復制并粘貼它們，然后設定 i 1。回到頂部，i = 2，宏選擇命名范圍中的第二行，并通過檢查運行它。
我對 VBA 很陌生，正在努力生成代碼來表達這一部分。
uj5u.com熱心網友回復：
復制命名范圍行
- 我將通過使用
For Each...Next回圈并使用Union將每個關鍵行組合成一個多范圍來處理這個問題。然后我會一口氣復制完整的范圍。這是一個基本的例子。
Option Explicit
Sub CopyNamedRangeRows()
' Constants
' Source
Const sName As String = "Sheet1"
Const srgName As String = "MyRange"
Const scCol As Long = 1 ' Criteria Column
' Destination
Const dName As String = "Sheet2"
Const dFirst As String = "A2"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(srgName)
Dim scrg As Range ' Source Copy Range
Dim srrg As Range ' Source Row Range
For Each srrg In srg.Rows
If Len(CStr(srrg.Cells(scCol).Value)) > 0 Then
If scrg Is Nothing Then
Set scrg = srrg
Else
Set scrg = Union(scrg, srrg)
End If
End If
Next srrg
If scrg Is Nothing Then
MsgBox "No rows found", vbExclamation
Exit Sub
End If
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dCell As Range: Set dCell = dws.Range(dFirst)
scrg.Copy dCell
' Finishing Touches
MsgBox "Done.", vbInformation
End Sub
如果您可以在需要適合的地方共享代碼，則肯定可以對其進行調整，或者更好的是，可以創建一個參考關鍵行（范圍）的函式。
為了能夠使用計數器變數，您可以替換
For Each srrg In srg.Rows為...Dim i As Long For i = 1 To srg.Rows.Count Set srrg = srg.Rows(i)...并替換
Next srrg為...Next i
uj5u.com熱心網友回復：
試試下面的代碼：
Sub copyRange(namedRange As Range)
Dim rng As Range
For Each rng In namedRange
'checking that the range is not empty
If rng <> "" Then
'copy it to your destination
rng.Copy anotherWB.yourdestinationWS.Range("A1")
End If
Next rng
End Sub
Sub test()
Dim myRange As Range
Set myRange = ActiveSheet.Range("A1:C5")
Call copyRange(myRange)
End Sub
如果您需要復制整行，我可以更新代碼。
轉載請註明出處，本文鏈接：https://www.uj5u.com/qita/358518.html
上一篇：范圍聯合方法有問題
下一篇：將XLSM保存到XLSX