[已解决]跨表复制单元格内容

凤鸣岐山

      综合表里A列与分类统计表F列数值相等时，将分类统计表G列--AA列的数据，复制到综合表的F列后边。
      问题：1、日期复制后格式不对。
                2、被复制的单元格的背景色过不去。

请教老师给予 指导！谢谢！

Sub 倒数据搬家()
    Dim x As Long, y As Long, i As Long, h As Long
        i = Sheet2.Range("g65536").End(xlUp).Row
        h = Sheet5.Range("d65536").End(xlUp).Row
        For x = 1 To i
          For y = 4 To h
            If Trim(Sheet2.Cells(x, "F")) = Trim(Sheet5.Cells(y, "A")) Then
                For k = 0 To 20
                 Sheet5.Cells(y, 6 + k) = Sheet2.Cells(x, 7 + k)
                Next k
            End If
          Next y
        Next x
    MsgBox "执行完毕!"
End Sub

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-2-24 22:03

Sub 倒数据搬家()

   Application.ScreenUpdating = False

   Dim x As Long, y As Long, i As Long, h As Long

   i = Sheet2.Range("g65536").End(xlUp).Row
   h = Sheet5.Range("d65536").End(xlUp).Row

   Set d = CreateObject("Scripting.Dictionary")
   For y = 4 To h
      d(Trim(Sheet5.Cells(y, "A"))) = y
   Next

   For x = 1 To i
      Key = Trim(Sheet2.Cells(x, "F").Value)
      If d.exists(Key) Then
         y = d(Key)
         Sheet2.Range(Sheet2.Cells(x, 7), Sheet2.Cells(x, 27)).Copy
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteFormats
         Application.CutCopyMode = False
      End If
   Next x

   MsgBox "执行完毕!"

End Sub

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

Sub 倒数据搬家()

   Application.ScreenUpdating = False

   Dim x As Long, y As Long, i As Long, h As Long

   i = Sheet2.Range("g65536").End(xlUp).Row
   h = Sheet5.Range("d65536").End(xlUp).Row

   Set d = CreateObject("Scripting.Dictionary")
   For y = 4 To h
      d(Trim(Sheet5.Cells(y, "A"))) = y
   Next

   For x = 1 To i
      Key = Trim(Sheet2.Cells(x, "F").Value)
      If d.exists(Key) Then
         y = d(Key)
         Sheet2.Range(Sheet2.Cells(x, 7), Sheet2.Cells(x, 27)).Copy
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
         Sheet5.Cells(y, 6).PasteSpecial Paste:=xlPasteFormats
         Application.CutCopyMode = False
      End If
   Next x

   MsgBox "执行完毕!"

End Sub

祝順心，南無阿彌陀佛！

凤鸣岐山

cutecpu 发表于 2021-2-24 22:03
Sub 倒数据搬家()

   Application.ScreenUpdating = False

感谢 老师深夜指导!非常好，我没学过字典，有程序了，结合百度，慢慢消化老师给的语句！谢谢！

阿弥陀佛！随喜功德！！！