в жестком коде
Когда диапазон источника подходит прямо к целевому диапазону
В этом решении используются кодовые имена рабочих листов, поэтому вы можете переименовать рабочие листы по своему усмотрению, и код все равно будет работать. В VBE в окне свойств (F4) имена кодов называются «(Имя)», а имена рабочих листов, которые вы видите на вкладках Excel, называются «Имя».
Sub Copy10To200()
Sheet1.Range("A1:A10").Copy Destination:=Sheet2.Range("A1:A200")
' Instead of:
' Worksheets("Sheet1").Range("A1:A10").Copy _
Destination:=Worksheets("Sheet2").Range("B1:B200")
End Sub
Немного более продвинутая версия
Что произойдет, если исходный диапазон не помещается прямо в целевой диапазон, описано в разделе примечания в конце end следующего кода.
'*******************************************************************************
' Purpose: Uses a one-column range of values on a worksheet to fill up
' a larger one-column range on a second worksheet.
'*******************************************************************************
Sub SmallColumnToColumn()
' Declare variables.
Const cStrSource As String = "A1:A10"
Const cStrTarget As String = "B1:B200"
Dim objRngSource As Range
Dim objRngTarget As Range
Dim lngRowsSource As Long
Dim lngRowsTarget As Long
Dim lngINT As Long
Dim lngMOD As Long
Const blnActiveWorkbook As Boolean = False
'***************************************************************************
' Additional Functionality:
' When FALSE is assigned to the previous boolean (blnActiveWorkbook),
' the initial functionality is triggered i.e. it only works within
' the workbook where it resides (ThisWorkbook) which is noticable in the
' following ELSE statement where also the codenames should be changed,
' if necessary.
' On the other hand, when TRUE is assigned, the initial functionality
' is expanded to any ActiveWorkbook which is noticable in the following
' WITH statement. The values (strings) of the codenames can now be changed
' in the following two CONSTANT STRING variables if necessary.
'***************************************************************************
' Create references to the ranges.
If blnActiveWorkbook Then
' Additional Functionality
Const cStrCodeNameSource As String = "Sheet1" ' CodeName (Sheet1)
Const cStrCodeNameTarget As String = "Sheet2" ' CodeName (Sheet2)
With ActiveWorkbook
On Error GoTo WorksheetSourceHandler
Set objRngSource = .Worksheets(CStr(.VBProject.VBComponents _
(cStrCodeNameSource).Properties(7))).Range(cStrSource) 'CodeName
On Error GoTo WorksheetTargetHandler
Set objRngTarget = .Worksheets(CStr(.VBProject.VBComponents _
(cStrCodeNameTarget).Properties(7))).Range(cStrTarget) 'CodeName
End With
Else
' Initial Functionality
Set objRngSource = Sheet1.Range(cStrSource) 'CodeName Sheet1
Set objRngTarget = Sheet2.Range(cStrTarget) 'CodeName Sheet2
' No error handling needed, because if one of the worksheets doesn't exist,
' the following error occurs: "Compile error: Variable not defined"
End If
' Assign the number of rows in the ranges to variables.
lngRowsSource = objRngSource.Rows.Count
lngRowsTarget = objRngTarget.Rows.Count
' Check if the first range has more rows then the second one.
' This ensures that lngINT (later in the code) is greater than 0.
If lngRowsSource > lngRowsTarget Then GoTo RowsHandler
' DEL the target column (ClearContents).
' objRngTarget.EntireColumn.ClearContents
' Range(objRngTarget.Resize(Rows.Count, 1).Address).ClearContents 'HaHaHa...
' Check if accidentally a multiple-columns range was specified. If so, resize
' the range to first-column-only.
Set objRngSource = objRngSource.Resize(lngRowsSource, 1)
Set objRngTarget = objRngTarget.Resize(lngRowsTarget, 1)
' Calculate INT and MOD
lngINT = Int(lngRowsTarget / lngRowsSource)
lngMOD = lngRowsTarget Mod lngRowsSource
' Copy/paste range INT times.
objRngSource.Copy Destination:=objRngTarget.Resize(lngINT * lngRowsSource, 1)
' Additionally copy/paste the first MOD number of rows.
If lngMOD > 0 Then
objRngSource.Resize(lngMOD, 1).Copy Destination:= _
objRngTarget.Offset(lngINT * lngRowsSource, 0).Resize(lngMOD, 1)
End If
ProcedureExit:
' Release object variables.
Set objRngSource = Nothing
Set objRngTarget = Nothing
Exit Sub
' Handle errors.
RowsHandler:
MsgBox "The source range (" & lngRowsSource & ") has to have fewer rows" _
& " than the target range (" & lngRowsTarget & ")."
GoTo ProcedureExit
WorksheetSourceHandler:
Select Case Err.Number
Case 9
MsgBox "There is no sheet with the CodeName '" & cStrCodeNameSource _
& "' to read from. Change the value in " _
& "'Const cStrCodeNameSource As String ='"
Case 1004
MsgBox "The range '" & cStrSource & "' is not a valid range." _
& " Change the value in " _
& "'Const cStrSource As String = '"
Case Else
MsgBox "An unexpected error has occured. Error '" & Err.Number & "'"
End Select
GoTo ProcedureExit
WorksheetTargetHandler:
Select Case Err.Number
Case 9
MsgBox "There is no sheet with the CodeName '" & cStrCodeNameTarget _
& "' to write to. Change the value in " _
& "'Const cStrCodeNameTarget As String ='"
Case 1004
MsgBox "The range '" & cStrTarget & "' is not a valid range." _
& " Change the value in " _
& "'Const cStrTarget As String = '"
Case Else
MsgBox "An unexpected error has occured. Error '" & Err.Number & "'"
End Select
GoTo ProcedureExit
End Sub
'*******************************************************************************
' Remarks:
' The Copy Method
' When using Destination with the Copy Method and the target range is bigger
' than the source range, the method atempts to fill the target range with
' the source range and it succeeds, if the source range fits EXACTLY ANY
' number of times into the target range. If it doesn't fit it pastes the
' source range ONLY ONCE, into the BEGINNING of the target range.
' In this code this issue is a little simplified due to the fact that it is
' using only one-colum ranges. The issue is resolved by using the INT
' function to calculate the amount of times the source range fits into
' the target range and by pasting it as many times, and additionally by
' using the MOD function to calculate the remainder of rows (if any) which
' is then used to copy the first rows of the source range to fill up the
' rest of the target range.
'*******************************************************************************