2014-09-26 82 views
0

我有一个excel VBA代码来合并工作簿中的工作簿中的工作表。首先,它想要复制所有单元格以从第一个工作表输出工作表。从下一个工作表开始,它想要复制从第二行,直到输入纸张的最后使用的row.The列标题可以不相同order.It是否显示在调试下面线查找最后使用的柱的自动化错误查找上次使用的列时发生运行时错误

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

Error message

整个代码如下:

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 
+0

请向我们显示错误消息。 – 2014-09-26 09:10:00

+0

在该行放置一个中断,然后检查以确保工作簿处于打开状态,并且已将ws2设置为正确的工作表和工作簿。 – 2014-09-26 10:33:23

+0

@RonRosefeld你可以请告诉我使'ws2'作为活动工作簿活动工作表的代码和它想要设置的位置吗? – 2014-09-26 11:33:08

回答

0

你用来获取LastColumn的代码绝对没问题。它在我的最后工作。

只有你需要检查你有评论线

Set ws2 = y.Sheets(1) 

请取消对同和检查时,必须编制。

相关问题