2017-08-21 15 views
0

特定の21セルをコピーし、コピー先のブックに貼り付けようとしています。 セルは、ソースブックでは順序が整っていませんが、宛先に配置されます。私は、フォルダ内のすべてのファイルをループする必要があります。同じセルが各ソースから引き出され、行を進む行先の同じ列に貼り付けられます。私は、この現在のコードは6Excel VBA:別のブックブックループから特定のセルをコピーして貼り付け

Sub loopit() 

Dim myfolder As String 
Dim myfile As String 
Dim i As Integer 

Dim x As Integer 
Dim y As Integer 


myfolder = "C:\\path\" 
myfile = Dir(myfolder & "*.xls") 

i = 2 

Do While myfile <> "" 
Workbooks.Open Filename:=myfolder & myfile, UpdateLinks:=0 
    x = Sheets("Suppressed").Range("H332").Value 
    y = Sheets("Suppressed").Range("H335").Value 
ActiveWorkbook.Close savechanges:=False 

Windows("cook_data.xlsm").Activate 
Sheets("cook").Select 
Cells(i, 2) = x 
Cells(i, 4) = y 

i = i + 1 

myfile = Dir 
Loop 

End Sub 

全く異なるが評価されて何かをしようとする任意のヘルプまたは勧告をオーバーフローエラーを返すアクティブコピー&ペーストの多くのバージョンを試してみましたが、常に1004

のようなエラーが表示されています。

答えて

0

Sub loopit() 

Dim myfolder As String 
Dim myfile As String 
Dim wb As Workbook, ws As Worksheet 
Set wb = ThisWorkbook 
Set ws = wb.Sheets("cook") 
Dim i As Integer 

Dim x As Integer 
Dim y As Integer 

myfolder = "C:\\path\" 
myfile = Dir(myfolder & "*.xls") 

i = 2 

Do While myfile <> "" 
    Workbooks.Open Filename:=myfolder & myfile, UpdateLinks:=0 
     x = Sheets("Suppressed").Range("H332").Value 
     y = Sheets("Suppressed").Range("H335").Value 
    ActiveWorkbook.Close savechanges:=False 

    ws.Activate 
    ws.Cells(i, 2) = x 
    ws.Cells(i, 4) = y 

    i = i + 1 

    myfile = Dir 
Loop 

End Sub 
+0

また、SUBはcook_data.xlsmファイルのモジュールになければなりません。 – Vlad67

0
Sub looper() 

Dim myFolder As String 
Dim myFile As String 
Dim wbX As Workbook 
Dim ws As Worksheet 
Dim i As Long 

'assign current sheet to variable 
Set ws = ActiveWorkbook.Sheets("cook") 

'assign directory (use only a single backslash after the colon) 
myFolder = "C:\path\" 
myFile = Dir(myFolder & "*.xls") 

'initialize counter 
i = 2 

'turn off screen updating 
Application.ScreenUpdating = False 

'begin loop 
Do While myFile <> "" 

    'open a file 
    Workbooks.Open Filename:=myFolder & myFile, UpdateLinks:=0 

    'assign the file to a variable 
    Set wbX = ActiveWorkbook 

    'directly assign values from opened file to original file 
    ws.Cells(i, 2).Formula = wbX.Sheets("Suppressed").Range("H332").Value 
    ws.Cells(i, 4).Formula = wbX.Sheets("Suppressed").Range("H335").Value 

    'close opened file 
    ActiveWorkbook.Close SaveChanges:=False 

    'increase counter 
    i = i + 1 

    'update file list 
    myFile = Dir 

Loop 

'turn screenupdating back on 
Application.ScreenUpdating = True 

End Sub 
+0

だから、私がする必要があったのは、ワークブックを追加することだけだった。ワークシート。私の範囲とシートにオーバーフローエラーを削除します。 –

0

私はあなたが達成しようとしているものを正確に取得するが、これはすべてのエラーメッセージなしで私のために動作するかどうか、これは私が一緒に行ったものです、それは

Sub iterateit() 

Dim myfolder As String 
Dim myFile As String 
Dim i As Integer 

Dim x As Integer 
Dim y As Integer 
Dim z As String 

Application.ScreenUpdating = False 

myfolder = "\\path\" 
myFile = Dir(myfolder & "*.xls") 

i = 2 

Do While myFile <> "" 
    Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0 
    x = ActiveWorkbook.Sheets("Suppressed").Range("h332").Value 
    y = ActiveWorkbook.Sheets("Suppressed").Range("h333").Value 
    z = myFile 


    ActiveWorkbook.Close SaveChanges:=False 

    Windows("cook.xltm").Activate 
    ActiveWorkbook.Sheets("cook").Cells(i, 2).Value = x 
    ActiveWorkbook.Sheets("cook").Cells(i, 3).Value = y 
    ActiveWorkbook.Sheets("cook").Cells(i, 4) = z 

    myFile = Dir 
    i = i + 1 
Loop 

ActiveWorkbook.Worksheets("cook").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("cook").Sort.SortFields.Add Key:=Range("D1"), _ 
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("cook").Sort 
    .SetRange Range("A2:D67") 
    .Header = xlNo 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
End Sub 
を働くこんにちはわかりません
関連する問題