[已解决]帮我改改，谢谢！！！

fangniuji

Sub test()
Dim i, r1, r2 As Long
r1 = Sheets("日数据").[o65536].End(xlUp).Row
r2 = Sheets("登记簿").[AM65536].End(xlUp).Row + 1
Sheets("日数据").Range("o3:y" & r1).Copy: Sheets("登记簿").Cells(r2, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False


'复制日数据到登记簿
For i = r2 To Sheets("登记簿").[AM65536].End(xlUp).Row
Sheets("登记簿").Cells(i, 1) = i - 2 '自动编号
Next i

MsgBox "数据保存结束!", vbExclamation

End Sub

为什么不复制，谢谢！！！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-4-22 14:53

1. Sheets("日数据").Range("o3:y" & r1).Copy: Sheets("登记簿").Cells(r2, 38).PasteSpecial xlPasteValues

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sheets("日数据").Range("o3:y" & r1).Copy: Sheets("登记簿").Cells(r2, 38).PasteSpecial xlPasteValues

复制代码

hwc2ycy

1. Sub test()
   
2.     Dim i, r1, r2 As Long
   
3.     Application.ScreenUpdating = False
   
4.     r1 = Sheets("日数据").[o65536].End(xlUp).Row
   
5.     r2 = Sheets("登记簿").[AM65536].End(xlUp).Row + 1
   
6.     Sheets("日数据").Range("o3:y" & r1).Copy: Sheets("登记簿").Cells(r2, 39).PasteSpecial xlPasteValues
   
7.     With Sheets("登记簿")
   
8.         r2 = .[AM65536].End(xlUp).Row
   
9.         If r2 > 3 Then .[al3] = 1: .Range("al3").AutoFill .Range("al3:al" & r2), xlFillSeries
   
10.         .Columns("am").NumberFormatLocal = "m/d"
    
11.     End With
    
12.     Application.CutCopyMode = False
    
13.     Application.ScreenUpdating = True
    
14.     MsgBox "数据保存结束!", vbExclamation
    
15. End Sub

复制代码

hwc2ycy

1. Sub test()
   
2.     Dim i, r1, r2 As Long
   
3.     Application.ScreenUpdating = False
   
4.     r1 = Sheets("日数据").[o65536].End(xlUp).Row
   
5.     r2 = Sheets("登记簿").[AM65536].End(xlUp).Row + 1
   
6.     Sheets("日数据").Range("o3:y" & r1).Copy: Sheets("登记簿").Cells(r2, 39).PasteSpecial xlPasteValues
   
7.     With Sheets("登记簿")
   
8.         r2 = .[AM65536].End(xlUp).Row
   
9.         If r2 > 3 Then .[al3] = 1: .Range("al3").AutoFill .Range("al3:al" & r2), xlFillSeries
   
10.         .Columns("am").NumberFormatLocal = "m/d"
    
11.         .UsedRange.HorizontalAlignment = xlCenter
    
12.     End With
    
13.     Application.CutCopyMode = False
    
14.     Application.ScreenUpdating = True
    
15.     MsgBox "数据保存结束!", vbExclamation
    
16. End Sub

复制代码