求助各位大佬 sheet1录入sheet2的方式

aguowork

西瓜9527 发表于 2019-6-13 17:19
1        2        3        4        5        6
小米        小米                               
        小米        小米                小米       

这样很乱，一行都没有录入完就跳到下一行，不太完美还是只能这样了？


1        2        3        4        5        6
小米  小米   小米   小米             小米           
小米  小米   小米  

最终目的就是能有序的一直排下去，不要流出空格      
               

西瓜9527

aguowork 发表于 2019-6-13 17:42
这样很乱，一行都没有录入完就跳到下一行，不太完美还是只能这样了？

可以实现  是我想确认你的需求

西瓜9527

西瓜9527 发表于 2019-6-13 19:57
可以实现  是我想确认你的需求

For i = 1 To 12
   Sheets("Sheet2").Cells(1048576, i).End(3).Offset(1, 0).Value = Sheets("Sheet1").Cells(4, i).Value
Next
Sheet1.Range("a4:l4").ClearContents

aguowork

西瓜9527 发表于 2019-6-13 20:07
For i = 1 To 12
   Sheets("Sheet2").Cells(1048576, i).End(3).Offset(1, 0).Value = Sheets("Sheet1" ...

非常感谢您的耐心帮助，需求已经完美实现了，代码也非常简洁简单，收藏了   谢谢您

aguowork

西瓜9527 发表于 2019-6-13 20:07
For i = 1 To 12
   Sheets("Sheet2").Cells(1048576, i).End(3).Offset(1, 0).Value = Sheets("Sheet1" ...

老师您好，我感觉还是有点不完美，操作起来多了的话有点分不清上一次录入了的结果，要是老师您还有空的话，希望能帮忙看看能不能实现，不急的   等您有空的时候再帮忙看看，谢谢您了
点击录入后将表2的导入结果变成红色并且变粗体


当再次录入之后，就把第二次导入的结果（变成红色并加粗）


下图示范：
这是第一次录入（将录入的结果变红色并加粗）


这是第二次录入（再次录入则取消之前录入的所有结果变色和加粗，并将此次录入的新结果变色加粗）

renkangjizhen

sub test()
dim rng1 as range,rng2 as range,i&
i=sheet1.[a65536].end(3).row
set rng1=sheet2.range("a4:l4")
set rng2=sheet1.range(cells(i,"a"),cells(i,"l"))
rng1.copy rng2
rng1.clearcontents
set rng1=nothing
set rng2=nothing
end sub

aguowork

renkangjizhen 发表于 2019-6-14 05:53
sub test()
dim rng1 as range,rng2 as range,i&
i=sheet1.[a65536].end(3).row

这个不对，不过还是得谢谢您

西瓜9527

aguowork 发表于 2019-6-14 13:23
这个不对，不过还是得谢谢您

附件上传不了，我说说修改步骤吧：
1、把表1 A4-L4单元格的字体格式改成红色、黑体（以后录入的时候不需要此步骤）
2、ALT+F11修改模块代码
3、如果不行我晚上再上传or加我Q
Application.ScreenUpdating = False
With Sheets("Sheet2").Range("A4:L1000")
     .Font.Name = "微软雅黑"  '????????
    .Font.ColorIndex = 1     '???????
     .Font.Bold = False     '????
End With
For i = 1 To 12
   Sheets("Sheet1").Cells(4, i).Copy
   Sheets("Sheet2").Cells(1048576, i).End(3).Offset(1, 0).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next
Sheet1.Range("a4:l4").ClearContents
Application.ScreenUpdating = True

aguowork

西瓜9527 发表于 2019-6-14 14:15
附件上传不了，我说说修改步骤吧：
1、把表1 A4-L4单元格的字体格式改成红色、黑体（以后录入的时候不需 ...

非常厉害，太感谢你了，搞了一整天
看了代码大概就是复制粘贴过去，但是连格式一起复制过去了
我改成这样了，其他的方法就不知道了。谢谢老师您！


Sub lfdj()

Sheets("Sheet1").Activate
    Range("A4:L4").Select
    Selection.Interior.Pattern = xlPatternNone


Application.ScreenUpdating = False
With Sheets("Sheet2").Range("A4:L1000")
     .Font.Name = "微软雅黑"
    .Font.ColorIndex = 1
     .Font.Bold = False
End With
For i = 1 To 12
   Sheets("Sheet1").Cells(4, i).Copy
   Sheets("Sheet2").Cells(1048576, i).End(3).Offset(1, 0).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Next
Sheet1.Range("a4:l4").ClearContents
Application.ScreenUpdating = True

Sheets("Sheet1").Activate
    Range("A4:L4").Select
    With Selection.Interior
        .Pattern = xlPatternSolid
        .Color = 65535
        .TintAndShade = 0
    End With
    Range("A5").Select

End Sub