從封閉的工作簿中複製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

回答

相關問題