vba Excel - 当日期介于两个用户设置参数之间时，在范围内复制和粘贴单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24875320/
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
Excel - Copy & paste cells within range when date falls between two user set parameters
提问by Snake
I am desperate to make this macro work. I would like a button click to prompt users to enter a beginning and end date, then the macro to copy cells data from B:F in every row where cell A* contains a date within the range starting with row 4. It would then focus to the destination sheet and paste the info into columns H:L starting at row 7.
我迫不及待地想让这个宏工作。我想要一个按钮点击提示用户输入开始和结束日期，然后宏从 B:F 复制单元格数据的每一行，其中单元格 A* 包含从第 4 行开始的范围内的日期。然后它会聚焦到目标工作表并将信息粘贴到从第 7 行开始的 H:L 列中。
The source table looks something like this, where rows 1-3 are devoted to sheet info and should be exempt from the macro's analysis
源表看起来像这样，其中第 1-3 行专门用于工作表信息，应免于宏的分析
| A | B | C | D | E | F |
-----------------------------------------
4 | Date |INFO |INFO |INFO |INFO |INFO |
5 | Date |INFO |INFO |INFO |INFO |INFO |
6 | Date |INFO |INFO |INFO |INFO |INFO |
7 | Date |INFO |INFO |INFO |INFO |INFO |
The destination sheet looks like this, with rows 1-6 being used for sheet info.
目标工作表如下所示，第 1-6 行用于工作表信息。
| H | I | J | K | L |
----------------------------------
7 |INFO |INFO |INFO |INFO |INFO |
8 |INFO |INFO |INFO |INFO |INFO |
9 |INFO |INFO |INFO |INFO |INFO |
10 |INFO |INFO |INFO |INFO |INFO |
And the code I have tried to piecemeal together is
我试图拼凑起来的代码是
Sub Copy_Click()
Dim r As Range
Set r = Range("B:F")
startdate = CDate(InputBox("Begining Date"))
enddate = CDate(InputBox("End Date"))
For Each Cell In Sheets("SOURCE").Range("A:A")
If Cell.Value >= startdate And Cell.Value <= enddate Then
Sheets("SOURCE").Select
r.Select
Selection.Copy
Sheets("DESTINATION").Select
ActiveSheet.Range("H:L").Select
ActiveSheet.Paste
Sheets("SOURCE").Select
End If
Next
End Sub
This is obviously not working, and there are no instructions to have it paste to the next available row, nor start on row 7 when pasting to the destination sheet.
这显然不起作用，并且没有说明将其粘贴到下一个可用行，也没有在粘贴到目标工作表时从第 7 行开始。
Any help would be amazing!
任何帮助都会很棒！
采纳答案by Tim Williams
Untested:
未经测试：
Sub Copy_Click()
Dim startdate As Date, enddate As Date
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range
Set shtSrc = Sheets("SOURCE")
Set shtDest = Sheets("DESTINATION")
destRow = 7 'start copying to this row
startdate = CDate(InputBox("Begining Date"))
enddate = CDate(InputBox("End Date"))
'don't scan the entire column...
Set rng = Application.Intersect(shtSrc.Range("A:A"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
'Starting one cell to the right of c,
' copy a 5-cell wide block to the other sheet,
' pasting it in Col H on row destRow
c.Offset(0, 1).Resize(1, 5).Copy _
shtDest.Cells(destRow, 8)
destRow = destRow + 1
End If
Next
End Sub
