从封闭的工作簿中复制excel VBA

好的我已经到了代码正在从封闭工作簿中读取数据并将其粘贴到该工作簿的工作表2中的地步。这是我的新代码：从封闭的工作簿中复制excel VBA

Sub Copy456() 

    Dim iCol As Long 
    Dim iSht As Long 
    Dim i As Long 



    'Fpath = "C:\testy" ' change to your directory 
    'Fname = Dir(Fpath & "*.xlsx") 

    Workbooks.Open ("run1.xlsx") 

    For i = 1 To Worksheets.Count 
     Worksheets(i).Activate 

    ' Loop through columns 
    For iSht = 1 To 6 ' no of sheets 
    For iCol = 1 To 6 ' no of columns 

     With Worksheets(i).Columns(iCol) 

      If ((.Cells(1, 1).Value = "Time")) Then ' if first cell=Time then copy two columns 
       Range(.Cells(1, 2), .End(xlDown)).Select 
       Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1) 
       Worksheets("Sheet2").Cells(i * 2 + 1) = Worksheets(i).Name 
      Else 
       ' do nothing 

      End If 
     End With 

    Next iCol 
    Next iSht 
Next i 
End Sub

但是，一旦我改变的代码部分：

  Selection.Copy Destination:=Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)

成代码：

Destination:=Workbooks("general.xlsx").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)

它停止工作发出错误：“订阅了范围“。文件general.xlsx是一个空文件，它也被关闭。

当我改变代码为：

`Selection.Copy Destination:=Workbooks("Your Idea.xlsm").Worksheets("Sheet2").Columns((i + 1) + i).Cells(2, 1)

然后发出一个错误：“1004不能更改合并单元格的一部分”。文件“您的Idea.xlsm”是我运行此脚本的文件。

这个问题的任何帮助？

来源

2012-01-27 novak100

尝试在循环的开始激活的工作表，也许使用ActiveWorksheet.Columns或只是ws.Columns与同为范围尽管这些并不像你所期望的那样引发错误，但是当涉及到使用范围等时，需要更加明确。否则，VBA只使用第一个工作表而不是每个工作表 – 2012-01-27 13:19:50

“VBA只使用第一个工作表而不是每个工作表”应该是VBA只是使用活动工作表... – 2012-01-27 13:26:38

因为我无法回答我的问题，所以我用新代码编辑了上一个问题，而ne w问题。你能再看看吗？ – novak100 2012-01-27 15:03:11

尝试在制作电子表格时避免合并单元格，因为在我的卑微体验中他们可以回来咬你。这就是我如何粗略地将数据从一张表复制到另一张表中，当迭代并设置所需的实际范围时，您需要实现自己的逻辑，但它应该给出一些想法，正如我在我的评论中所说的那样更明确当设置范围并避免magic。

AFAIK你必须为了打开文件，操纵它们用VBA

Sub makeCopy() 
    ' turn off features 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    ' some constants 
    Const PATH = "" 
    Const FILE = PATH & "FOO.xls" 

    ' some variables 
    Dim thisWb, otherWb As Workbook 
    Dim thisWs, otherWs As Worksheet 
    Dim i As Integer: i = 0 
    Dim c As Integer: c = 0 
    Dim thisRg, otherRg As Range 

    ' some set-up 
    Set thisWb = Application.ActiveWorkbook 
    Set otherWb = Application.Workbooks.Open(FILE) 

    ' count the number of worksheets in this workbook 
    For Each thisWs In thisWb.Worksheets 
     c = c + 1 
    Next thisWs 

    ' count the number of worksheets in the other workbook 
    For Each thisWs In otherWb.Worksheets 
     i = i + 1 
    Next thisWs 

    ' add more worksheets if required 
    If c <= i Then 
     For c = 1 To i 
      thisWb.Worksheets.Add 
     Next c 
    End If 

    ' reset i and c 
    i = 0: c = 0 

    ' loop through other workbooks worksheets copying 
    ' their contents into this workbook 
    For Each otherWs In otherWb.Worksheets 
     i = i + 1 
     Set thisWs = thisWb.Worksheets(i) 

     ' ADD YOUR OWN LOGIC FOR SETTING `thisRg` AND 
     ' `otherRg` TO THE APPROPRIATE RANGE 
     Set thisRg = thisWs.Range("A1: C100") 
     Set otherRg = otherWs.Range("A1: C100") 

     otherRg.Copy (thisRg) 

    Next otherWs 

    ' save this workbook 
    thisWb.Save 

    ' clean up 
    Set otherWs = Nothing 
    otherWb.Close 
    Set otherWb = Nothing 
    Set thisWb = Nothing 
    Set thisWs = Nothing 

    ' restore features 
    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.Calculate 

End Sub

来源

2012-01-27 16:25:04

从封闭的工作簿中复制excel VBA

回答

相关问题