从多行复制值

我所需要做的就是复制不同行的值，比如A40行：D40，A47：D47等等。我的代码一次只能正常运行一行，但是当我尝试做两行不同的行时，说A40：D40和A47：D47它将复制A40：D40和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 

循环

结束小组

Answer 1

如果你总是select相同的一组行，你可以像下面那样硬编码。

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

或者，如果你的范围非常那么你可以设置一个相对string，然后使用相同的方法。

 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