我现在只使用Excel中的宏大约4个月了,并且基本上通过查找现有代码并弄清楚它是如何工作来自学。我现在有点卡住了。
我在Excel工作簿中有一个报告。我需要根据D列中显示的数据将数据复制到多个工作表(在同一工作簿中)。也就是说,我需要复制D列符合某些条件的整行。原始工作表包含公式,但我只希望在复制数据时显示值。
我能够复制数据,但我有两个问题: 1)公式是复制,而不仅仅是值 2)数据出现在单元格A2的新工作表中,但我需要它从单元格A5开始
我将此设置为模板,因为主报告需要每月运行和拆分,因此我复制的范围不会是恒定的。这是我目前使用的代码示例:
Sub RefreshSheets()
Sheets("ORIGIN").Select
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("D" & r).Value = "movedata" Then
Rows(r).Copy Destination:=Sheets("DESTINATION").Range("A" & lr2 + 1)
lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
End Sub
我尝试在“.Range(”A“& lr2 + 1)”之后添加“.PasteSpecial Paste:= xlPasteValues”,但是我收到编译错误(预期:语句结束)。我确信我已经错过了一些显而易见的东西(这是我使用的代码我还没有完全理解),但到目前为止我没有尝试过任何工作。
非常感谢任何建议。
答案 0 :(得分:3)
第一个版本使用For循环(它可能很慢,有很多行)
Option Explicit
Public Sub RefreshSheets()
Dim wsO As Worksheet, wsD As Worksheet, lrO As Long, lrD As Long, r As Long
Set wsO = ThisWorkbook.Sheets("ORIGIN")
Set wsD = ThisWorkbook.Sheets("DESTINATION")
lrO = wsO.Cells(Rows.Count, "A").End(xlUp).Row
lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row
If lrD < 5 Then lrD = 5
For r = lrO To 2 Step -1
If wsO.Range("D" & r).Value2 = "movedata" Then
wsO.Rows(r).Copy
wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues
lrD = lrD + 1
End If
Next
End Sub
此版本使用AutoFilter一次性复制带有“movedata”的所有行:
Public Sub RefreshSheetsFast()
Dim wsO As Worksheet, wsD As Worksheet, lrD As Long
Set wsO = ThisWorkbook.Sheets("ORIGIN")
Set wsD = ThisWorkbook.Sheets("DESTINATION")
lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row
If lrD < 5 Then lrD = 5 'Makes sure the first row on DESTINATION sheet is >=5
If Not wsO.AutoFilter Is Nothing Then wsO.UsedRange.AutoFilter
With wsO.UsedRange
.Columns(4).AutoFilter Field:=1, Criteria1:="movedata"
.Offset(1).Resize(.Rows.Count - 1).Copy 'Excludes the header (row 1)
End With
wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wsO.UsedRange.AutoFilter 'Removes the "movedata" filter
End Sub
答案 1 :(得分:1)
执行复制和粘贴作为两个单独的请求:
Sub RefreshSheets()
Sheets("ORIGIN").Select
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
If Range("D" & r).Value = "movedata" Then
Rows(r).Copy
Sheets("DESTINATION").Range("A" & lr2 + 1).PasteSpecial xlPasteValues
lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
End Sub