求大神解答：vba怎么把sheet1里符合对应条件的所有行全都复制到sheet2里面

zhuyan0502

需求为：如果sheet1“五级分类不一致借据清单”中的借款日字段的数据，等于系统当前时间所在的上一月最后一天，那么就将该行记录整理到sheet2“xx月xx日新发放”中。求大神解答该如何解决？除此之外，怎么才可以将系统当前时间的月和日赋给sheet2工作表的名字“xx月xx日新发放”？还望大神能解答我心中的疑惑，万分感谢。

不知道为什么

不是刚发了这个贴子？重复发帖很好？

zhuyan0502

不知道为什么 发表于 2018-8-17 15:40
不是刚发了这个贴子？重复发帖很好？

您好，两个帖子都是把第一个表单内容复制到第二个表单，但是需求和表单是不一样的，不好意思，可能我的标题没有标注清楚，还望您见谅

不知道为什么

zhuyan0502 发表于 2018-8-17 15:57
您好，两个帖子都是把第一个表单内容复制到第二个表单，但是需求和表单是不一样的，不好意思，可能我的标 ...

那这个问题解决了，你后面还会有延申得问题？

zhuyan0502

不知道为什么 发表于 2018-8-17 15:58
那这个问题解决了，你后面还会有延申得问题？

。。。这个，需求不是一个类型的，如果还是根据文本内容来判断，根据您刚才的答案我或许能写出来，但是这个是跟系统当前时间判断来筛选，小弟之前没接触过VBA编程，还没入门，如果您可以抽空解答我一点困惑的话不胜感激。再次谢谢您上一个的解答，谢谢。

不知道为什么

zhuyan0502 发表于 2018-8-17 16:09
。。。这个，需求不是一个类型的，如果还是根据文本内容来判断，根据您刚才的答案我或许能写出来，但是这 ...

原理相通啊，你对日期判断下，符合的就记录下来。

当前月的上个月最后一天  可以用 dateserial

这人更

楼主看看是不是这个意思

这人更

Sub aa()
a = Now()
k = 1
arr = Split(a, "/")
d1 = arr(0)
d = arr(1)
d2 = arr(2)
cc = Mid(d2, 1, 2)
If d = 1 Or d = 3 Or d = 5 Or d = 7 Or d = 8 Or d = 10 Or d = 12 Then
dd = 31
End If
If d = 4 Or d = 6 Or d = 9 Or d = 11 Then
dd = 30
End If
If d = 2 Then
dd = 28
End If
MsgBox 2018 & "/" & d - 1 & "/" & dd
For i = 2 To Sheets("五级分类不一致借据清单").UsedRange.Rows.Count
    If Sheets("五级分类不一致借据清单").Cells(i, 6).Text = 2018 & "/" & d - 1 & "/" & dd Then
    k = k + 1
    Sheets("xx月xx日新发放").Cells(k, 1).Resize(1, 34) = Sheets("五级分类不一致借据清单").Cells(i, 1).Resize(1, 34).Value
    End If
Next
    Sheets("xx月xx日新发放").Name = d & "月" & cc & "日" & "新发放"
End Sub

liujialin0o0

1. Sub tt()
   
2. 
   
3. Sheets(1).Activate
   
4. Set arr = Sheets(1).Range(Cells(2, 6), Cells(Rows.Count, 6).End(3))
   
5. For Each Rng In arr
   
6.     Sheets(1).Activate
   
7.     m = CDate(Rng)
   
8.     n = Date - Day(Date)
   
9.     If m = n Then
   
10.         Rng.EntireRow.Copy
    
11.         Sheets(2).Activate
    
12.         Cells(Rows.Count, 1).End(3).Offset(1, 0).Select
    
13.         Sheets(2).Paste
    
14.     End If
    
15. Next
    
16. 
    
17. Sheets(2).Name = Month(Date) & "月" & Day(Date) & "日新发放"
    
18. Sheets(2).cells(1,1).select
    
19. End Sub

复制代码

这人更

修改了一下