Question

我有一个文件，其中名称列在A列中，其他列中包含信息。使用IF函数我决定我需要使用哪个工作簿，然后我将一个工作表添加到包含A列中名称的特定工作簿中。代码工作正常，直到第7行然后停止工作，我不知道为什么。我得到了Run-time error 1004。一次，它工作正常，然后我再次测试它，它完全崩溃。你能帮帮我吗？

    Dim Ki As range
    Dim ListSh As range
    Dim x As Integer
    Dim lr As Integer
    Dim wbkRAM As Workbook
    Dim wbkPSS As Workbook

    Set wbkRAM = Workbooks.Open(Filename:="C:\Users\212478002\Desktop\VCP\PSS\RAM.xlsx")
    Set wbkPSS = Workbooks.Open(Filename:="C:\Users\212478002\Desktop\VCP\PSS\PSS.xlsx")

    lr = Cells(Rows.Count, 1).End(xlUp).Row

            With ThisWorkbook.Sheets("Sheet1")

                 Set ListSh = .range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

            End With

    For x = 1 To lr

        For Each Ki In ListSh

          x = x + 1

                If ThisWorkbook.Sheets("Sheet1").Cells(x, "B") = "PSS" Then

                        wbkPSS.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Ki.Value
                        ThisWorkbook.Sheets("Sheet1").Cells(x, "D").Copy
                        wbkPSS.Sheets(Ki.Value).Cells(1, "A").PasteSpecial

                Else
                        wbkRAM.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Ki.Value
                        ThisWorkbook.Sheets("Sheet1").Cells(x, "C").Copy
                        wbkRAM.Sheets(Ki.Value).Cells(1, "A").PasteSpecial
                End If
        Next
    Next
End Sub

Answer 1

试试这个，如果你收到错误，请点击调试，让我知道导致错误的行是什么..

Dim x As Integer
Dim lr As Integer
Dim wbkRAM As Workbook
Dim wbkPSS As Workbook
Dim ws As Worksheet
Sub dunnothename()
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set wbkRAM = Workbooks.Open(Filename:="C:\Users\212478002\Desktop\VCP\PSS\RAM.xlsx")
    Set wbkPSS = Workbooks.Open(Filename:="C:\Users\212478002\Desktop\VCP\PSS\PSS.xlsx")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set ListSh = ws.Range("A2:A" & lr)
    For x = 1 To lr
        If ws.Cells(x, 2) = "PSS" Then
                wbkPSS.Sheets.Add(After:=wbkPSS.Sheets(wbkPSS.Sheets.Count)).Name = ws.Cells(x, 1).Value
                ws.Cells(x, 4).Copy wbkPSS.Sheets(ws.Cells(x, 1).Value).Cells(1, 1)
        Else
                wbkRAM.Sheets.Add(After:=wbkRAM.Sheets(wbkRAM.Sheets.Count)).Name = ws.Cells(x, 1).Value
                ws.Cells(x, 3).Copy wbkRAM.Sheets(ws.Cells(x, 1).Value).Cells(1, 1)
        End If
    Next
End Sub

将工作表创建为两个不同的工作簿，并在ThisWorkbook中的列表后命名它们

1 个答案: