Question

因此，根据这个棘手的问题（VBA migrating data from different worksheets to one worksheet at specific locations），我根据其他代码研究人员/专家的帖子编辑了以下代码。

之前的代码（请参阅链接）正在努力达到运行时错误出现的某一点。我已按照建议删除。选择。然而，从复制/粘贴操作中激活，但是目前下面的代码没有做任何事情，从原料记录表中复制了＃39;向前。我确信我做错了或者我可以用不同的方式处理我的问题，但我很难找到解决方案。有没有人有任何想法？

经过调试后，我设法克服了与细胞相关的错误13，虽然定义为日期，但日期顺序搞砸了，一旦我改变了单元格的顺序就可以了。但是我知道在下面的评论中有错误1004（参见我的上一条评论）。我想知道是否有人有任何关于如何解决这个问题的方法。我已经标记了错误出现的位置（它在第二个循环中）。在sht5中，日期仅在2015年1月1日开始，但是sht4从07/08/2014开始。在我在2014年的第一天修复了问题后，代码能够运行，直到它达到值01/01/2015，当过去特殊时，在下面的粗体中指定的范围。有人可以帮忙吗？感谢

Option Explicit

Sub main()

'open/close worksheets from huddle folder and teamviewer'

Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Wb3 As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim sht4 As Worksheet
Dim sht5 As Worksheet
Dim i As Long, j As Long, k As Long, lastrow1 As Long, lastrow2 As Long, lastrow3 As Long
Dim monthsi As Date, monthsk As Date, monthsj As Date

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

Set Wb1 = Workbooks.Open("U:\Data from plants\Huddle\EEL Feedstock Records -  NEW VERSION.xlsx")
Set Wb2 = Workbooks.Open("U:\Data from plants\Teamviewer\EE.xlsx")
Set Wb3 = ThisWorkbook
Set sht1 = Wb1.Sheets("Feedstock Usage (Non-beet site)")
Set sht2 = Wb2.Sheets("Sheet1")
Set sht3 = Wb3.Sheets("Feedstock records")
Set sht4 = Wb3.Sheets("Teamviewer")
Set sht5 = Wb3.Sheets("Plants data")

sht3.Cells.Delete Shift:=xlUp
sht4.Cells.Delete Shift:=xlUp

sht1.Cells.Copy
sht3.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
Wb1.Close False

sht2.Cells.Copy
sht4.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
Wb2.Close False


'copy from feedstock records sheet'
lastrow1 = sht3.Range("C" & Rows.Count).End(xlUp).Row
i = 10
lastrow2 = sht4.Range("A" & Rows.Count).End(xlUp).Row
k = 4
lastrow3 = sht5.Range("A" & Rows.Count).End(xlUp).Row
j = 5

Do
    monthsi = sht3.Cells(i, "C").Value
    If sht5.Cells(j, "A").Value = monthsi Then
    sht3.Range(Cells(i, "D"), Cells(i, "E")).Copy
    sht5.Range(Cells(j, "VE"), Cells(j, "VF")).PasteSpecial xlPasteValues
    sht3.Range(Cells(i, "G"), Cells(i, "H")).Copy
    sht5.Range(Cells(j, "VI"), Cells(j, "VJ")).PasteSpecial xlPasteValues
    sht3.Range(Cells(i, "J"), Cells(i, "K")).Copy
    sht5.Range(Cells(j, "VM"), Cells(j, "VN")).PasteSpecial xlPasteValues
    sht3.Range(Cells(i, "M"), Cells(i, "N")).Copy
    sht5.Range(Cells(j, "VY"), Cells(j, "VZ")).PasteSpecial xlPasteValues
    sht3.Range(Cells(i, "P"), Cells(i, "Q")).Copy
    sht5.Range(Cells(j, "VQ"), Cells(j, "VR")).PasteSpecial xlPasteValues
    End If
    i = i + 1
Loop Until i = lastrow1 + 1

Do
monthsk = sht4.Cells(k, "A").Value

    If sht5.Cells(j, "A").Value = monthsk Then
     sht4.Cells(k, "H").Copy
     sht5.Cells(j, "XW").PasteSpecial xlPasteValues
     sht4.Cells(k, "I").Copy
     sht5.Cells(j, "YJ").PasteSpecial xlPasteValues
     sht4.Range(Cells(k, "J"), Cells(k, "O")).Copy
     **sht5.Range(Cells(j, "ZK"), Cells(j, "ZP")).PasteSpecial xlPasteValues**
     sht4.Cells(k, "U").Copy
     sht5.Cells(j, "XU").PasteSpecial xlPasteValues
     sht4.Cells(k, "X").Copy
     sht5.Cells(j, "XV").PasteSpecial xlPasteValues
     sht4.Cells(k, "Y").Copy
     sht5.Cells(j, "YH").PasteSpecial xlPasteValues
     sht4.Cells(k, "AB").Copy
     sht5.Cells(j, "YI").PasteSpecial xlPasteValues
     sht4.Range(Cells(k, "AN"), Cells(i, "AP")).Copy
     sht5.Range(Cells(j, "XR"), Cells(j, "XT")).PasteSpecial xlPasteValues
     sht4.Cells(k, "AQ").Copy
     sht5.Cells(j, "XQ").PasteSpecial xlPasteValues
     End If
     k = k + 1
Loop Until k = lastrow2 + 1

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With

End Sub

Answer 1

您可能希望在循环中设置monthsi，monthsj和monthsk。例如，您在第一个循环中增加i，但这不会更改monthsi，因此如果比较结果为false，那么if语句将永远不会运行。

例如，第一个循环将成为：

Do
    monthsi = sht3.Cells(i, "C").Value
    If monthsj = monthsi Then
        sht3.Range(Cells(i, "D"), Cells(i, "E")).Copy
        sht5.Range(Cells(j, "VA"), Cells(j, "VB")).PasteSpecial xlPasteValues
        sht3.Range(Cells(i, "G"), Cells(i, "H")).Copy
        sht5.Range(Cells(j, "VE"), Cells(j, "VF")).PasteSpecial xlPasteValues
        sht3.Range(Cells(i, "J"), Cells(i, "K")).Copy
        sht5.Range(Cells(j, "VI"), Cells(j, "VJ")).PasteSpecial xlPasteValues
        sht3.Range(Cells(i, "M"), Cells(i, "N")).Copy
        sht5.Range(Cells(j, "VM"), Cells(j, "VN")).PasteSpecial xlPasteValues
        sht3.Range(Cells(i, "P"), Cells(i, "Q")).Copy
        sht5.Range(Cells(j, "VQ"), Cells(j, "VR")).PasteSpecial xlPasteValues
    End If
    i = i + 1
Loop Until i = lastrow1 + 1 Or j = lastrow3 + 1

这仍然是PartyHatPanda提出的问题，即当j未发生变化时，为什么要检查j以结束循环，因此逻辑中可能存在更深层次的错误。即如果j也应该增加，那么monthsj的赋值也应该以相同的方式进入循环。

根据条件，在不同的工作表中复制/粘贴从非连续列到非连续列的一系列数据

1 个答案: