Question

我需要做的就是从不同的行复制值，比如行A40：D40，A47：D47等。我有一次正确运行一行的代码，但是当我尝试做两个不同的行时说A40：D40和A47：D47它将复制A40：D40＆amp; A41：D41。

Sub LoopCopyValues()
Dim MyFile As String
Dim FilePath As String


FilePath = "C:\Users\"
MyFile = Dir(FilePath)

Do While Len(MyFile) > 0
    If MyFile = "Master Macro.xlsm" Then
    Exit Sub
End If

Workbooks.Open (FilePath & MyFile)

ActiveWorkbook.Worksheets("A2) Monthly P&L (Source)").Activate

Range("CZ447:DC447").Copy

ActiveWorkbook.Close False

Range("B" & Rows.Count).End(xlUp).Offset(1).Select

ActiveSheet.Paste

MyFile = Dir

循环

End Sub

Answer 1

如果您始终选择相同的行集，则可以像下面一样对其进行硬编码。

Range("A8:D9,A12:D13,A16:D17").Select
Selection.Copy

或者，如果您的范围非常大，则可以设置相对字符串，然后使用相同的方法。

rw1 = Range("a50000").End(xlUp).Row
clm1 = Range("a50000").End(xlToLeft).Column
rng1 = "a1:" & Cells(rw1, clm1).Address(False, False)

rw2 = Range("a50000").End(xlUp).Row
clm2 = Range("a50000").End(xlToLeft).Column
'may being whatever your critera is for finding a reference cell
fnd2 = Cells.Find(What:="may", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Address

rng2 = fnd2 & ":" & Cells(rw1, clm1).Address(False, False)
rng1 = rng1 & "," & rng2

Range(rng1).Select
Selection.Copy

Answer 2

尝试

Range("A40:D40, A47:D47").Copy

在不使用.Select的情况下执行此操作的另一种方法：

Sub LoopCopyValues()
Dim MyFile As String
Dim FilePath As String
Dim ws1 As Excel.Worksheet, wb2 As Excel.Workbook

Set ws1 = ActiveWorksheet

FilePath = "C:\Users\"
MyFile = Dir(FilePath)

Do While Len(MyFile) > 0    
    If MyFile = "Master Macro.xlsm" Then
        Exit Sub
    Else
        Set wb2 = Workbooks.Open(FilePath & MyFile)
        Range("CZ447:DC447").Copy Destination:= _
            ws1.Range("B" & ws1.Rows.Count).End(xlUp).Offset(1, 0)

        wb2.Close False

        MyFile = Dir
    End If
Loop

Set ws1 = Nothing
Set wb2 = Nothing

End Sub

从多行复制值

2 个答案: