使用 VBA 选择和复制多个范围
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/45705044/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Select and Copy multiple ranges with VBA
提问by Luu nguyen
I want to copy multiple range to another workbook. I have the code below. How can I replace the number 1000 by iLastRow
我想将多个范围复制到另一个工作簿。我有下面的代码。如何用 iLastRow 替换数字 1000
iLastRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
sh.Range("A3:AG1000, AL3:EJ1000").Select
Selection.Copy
回答by Shai Rado
Try the code below, explanation inside the code as comments:
试试下面的代码，代码中的解释作为注释：
Option Explicit
Sub CopyMultipleRanges()
Dim iLastRow As Long
Dim sh As Worksheet
Dim MultiRng As Range
Set sh = ThisWorkbook.Worksheets("Sheet1") ' <-- change to your sheet's name
With sh
iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' use the union to set a range combined from multiple ranges
Set MultiRng = Union(.Range("A3:A" & iLastRow), .Range("AL3:EJ" & iLastRow))
End With
' copy the range, there's no need to select it first
MultiRng.Copy
End Sub
Another question is how you want to paste the merged reanges that have a gap in the middle.
另一个问题是如何粘贴中间有间隙的合并范围。
回答by Duc Anh Nguyen
The Union method is a solution to this problem. but it also has its cons
Union方法是解决这个问题的方法。但它也有它的缺点
The union range should be the same first row and last row. On the other hand, you can just select the first cell to paste. you can alway do like this. the main point here is the row number should be the same. here I synchronize both range with the same variable. in your case, change to last cell.
联合范围应该是相同的第一行和最后一行。另一方面，您可以只选择要粘贴的第一个单元格。你总是可以这样做。这里的要点是行号应该相同。在这里，我将两个范围与相同的变量同步。在您的情况下，更改为最后一个单元格。
j=1
i = 4
Set MultiRng = Union(Range("A" & j & ":B" & i), Range("D" & j & ":E" & i))
回答by M_Idrees
Change Range params from this:
从此更改范围参数：
iLastRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
sh.Range("A3:AG1000, AL3:EJ1000").Select
To:
到：
iLastRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
sh.Range("A3:AG" & iLastrow &", AL3:EJ" & iLastRow).Select
Since with multiple selection Copywill not work. You may need to call it twice in your case. (as per suggestion by @YowE3K)
由于多选Copy将不起作用。在您的情况下，您可能需要调用它两次。（根据@YowE3K 的建议）
sh.Range("A3:AG" & iLastrow).Select
Selection.Copy
sh.Range("AL3:EJ" & iLastrow).Select
Selection.Copy
回答by Luu nguyen
Option Explicit
Sub import_APVP()
Dim master As Worksheet, sh As Worksheet
Dim wk As Workbook
Dim strFolderPath As String
Dim selectedFiles As Variant
Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
Dim strFileName As String
Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
Dim MultiRng As Range
Dim startTime As Double
getSpeed (True)
Set master = ActiveWorkbook.ActiveSheet
strFolderPath = ActiveWorkbook.Path
ChDrive strFolderPath
ChDir strFolderPath
Application.ScreenUpdating = False
'On Error GoTo NoFileSelected
selectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
strFileName = selectedFiles(iFileNum)
Set wk = Workbooks.Open(strFileName)
For Each sh In wk.Sheets
If sh.Name Like "DATA*" Then
With sh
iLastRowReport = .Range("D" & .Rows.Count).End(xlUp).Row
iNumberOfRowsToPaste = iLastRowReport + 2 - 1
'.Range("A3:AG" & iLastRowReport & " , AL3:EJ & iLastRowReport").Select
' Selection.Copy
Set MultiRng = Union(.Range("A3:AG" & iLastRowReport), .Range("AL3:EJ" & iLastRowReport))
'you delete the 3 in range ("AL:EJ....) that make your code not work.
MultiRng.Copy
With master
iCurrentLastRow = .Range("B" & .Rows.Count).End(xlUp).Row
iRowStartToPaste = iCurrentLastRow + 1
'.Activate ' <-- not needed
.Range("A" & iRowStartToPaste).PasteSpecial xlPasteAll
'ActiveSheet.Paste <-- not needed
End With
End With
End If
Next sh
wk.Close
Next
getSpeed (False)
Application.ScreenUpdating = True
NoFileSelected:
End Sub
