查找上次使用的列时出现运行时错误

Question

我有一个excel VBA代码来合并文件夹的工作簿中的工作表。首先它要将所有单元格从第一张工作表复制到输出工作表。接下来，它要从第2行复制到最后使用的行。输入表的列标题可能不是相同的顺序。在调试以下行以查找上次使用的列时显示自动化错误

   **lco = ws2.Cells(1, Columns.Count).End(xlToLeft).Column** 

整个代码如下：

Application.ScreenUpdating = False
directory = "C:\Users\Desktop\MYExcel\Input\"
fileName = Dir(directory & "*.xl??")
  i = 0
  j = 0
     'create new output file
   Set Wk = Workbooks.Add
            With Wk
                .Title = "All Sheets"
                .SaveAs fileName:="C:\Users\Desktop\MYExcel\Output\AllSheets.xlsx"
                .Close
             End With

 Do While fileName <> ""
           If i = 0 Then
           Set x = Workbooks.Open(directory & fileName) 'Opening the first workbook in directory
           Set y = Workbooks.Open("C:\Users\Desktop\MYExcel\Output\AllSheets.xlsx") 'opening the output workbook
     Set ws2 = y.Sheets(1)
        If j = 0 Then
              Set ws1 = x.Sheets(1)

                With ws1
                    .Cells.Copy ws2.Cells 'Copying all cells to output sheet for s
                    y.Close True
                    'x.Close False
                End With
                j = j + 1
        End If
        If j > 0 Then
            For Each sheet In x.Worksheets
                'Set ws2 = y.Sheets(1)
               ' lColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
                 lci = sheet.Cells(1, Columns.Count).End(xlToLeft).Column
                 **lco = ws2.Cells(1, Columns.Count).End(xlToLeft).Column**
                 lri = sheet.Range("A65536").End(xlUp).Row
                 lro = ws2.Range("A65536").End(xlUp).Row
                For Each cell In rng
                    For Each cell2 In rng2
                         l = ActiveCell.Column
                        If cell.Value = cell2.Value Then
                            With sheet
                                .Cells(cell, 2).EntireColumn.Copy ws2.Cells(cell2).Range(lro)
                            End With
                        End If
                    Next cell2
                Next cell
            Next sheet
        End If
    Workbooks(directory & fileName).Close
    fileName = Dir()
    i = i + 1

Else

    Set d = Workbooks.Open(directory & fileName)
    Set f = Workbooks.Open("AllSheets.xls*")
    'Windows("Book3.xlsm").Activate
    For Each sheet In x.Worksheets
            Set ws4 = f.Sheets(1)
             lci = sheet.Cells(1, sheet.Columns.Count).End(xlToLeft).Column
             lco = ws4.Cells(1, ws4.Columns.Count).End(xlToLeft).Column
             lri = sheet.Range("A65536").End(xlUp).Row
             lro = ws4.Range("A65536").End(xlUp).Row

            Set rng = sheet.Range("A1:A" & lci)
            Set rng2 = ws4.Range("A1:A" & lco)

            For Each cell In rng
                For Each cell2 In rng2
                     l = ActiveCell.Column
                    If cell.Value = cell2.Value Then
                         With sheet
                            .Cells(cell, 2).EntireColumn.Copy ws4.Cells(cell2).Range(lro)
                         End With
                    End If
                Next cell2
            Next cell
    Next sheet
 End If
Loop

Answer 1

您以前使用LastColumn的代码绝对没问题。它正在我的工作。

只有您需要检查是否已对该行进行了评论

Set ws2 = y.Sheets(1)

请取消注释并检查，它必须有效。