2012-01-27 11 views
0

私は、コードが閉じられたブックからデータを読み取り、そのブックのsheet2に貼り付けることができるポイントに到達します。この私の新しいコードです:それは発行エラーが動作を停止クローズドブックからのコピーExcel VBA

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

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) 

「サブスクリプションが出ています範囲の "。 ファイルgeneral.xlsxも閉じている空のファイルです。これは、エラーを発行し

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

は私がにコードを変更すると、「1004年は、マージされたセルの一部を変更することはできません」。 ファイル "Your Idea.xlsm"は、このスクリプトを実行しているファイルです。

この問題のサポートはありますか?

+0

ループの最初にワークシートを活性化しようとするかもしれないためActiveWorksheet.Columnsまたはちょうどws.Columnsと同じを使用して、それらを操作するためにファイルを開く必要がありますあなたがRangesなどの使用に関してもっと明示する必要があると思われるので、これらはエラーを投げていませんが、VBAは各ワークシートではなく最初のワークシートを使用します。 –

+0

「VBAは各ワークシートではなく最初のワークシートを使用します」はVBAアクティブシートを使用しています... –

+0

私の質問に答えることができないので、私は新しいコードとneで前の質問を編集しましたwの問題。あなたはもう一度それを見ることができますか? – novak100

答えて

2

私の謙虚な経験のようにスプレッドシートを作成するときに合併したセルを避けるようにしてください。これは、私がおおよそ1枚のシートから別のシートにデータをコピーする方法です。必要な実際の範囲を反復して設定する際に独自のロジックを実装する必要がありますが、範囲を設定するときは避けてください。magic

私の知る限り、あなたが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 
関連する問題