Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/28.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/15.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
循环以从其他Excel工作表填充Excel_Excel_Vba - Fatal编程技术网

循环以从其他Excel工作表填充Excel

循环以从其他Excel工作表填充Excel,excel,vba,Excel,Vba,我有一个主Excel工作簿,我需要从其他Excel文件填充它。。。。基本上从一个文件夹中逐个打开每个文件,然后复制粘贴到主工作簿上。。。我写了一个宏。。但它仍然有一些流量。。。我不知道该怎么做 Option Explicit Sub fill() Dim wb As Workbook, wb2 As Workbook, mywb As Workbook Dim sPath As String, sFilename As String Dim NbRows As Integer, rg As R

我有一个主Excel工作簿,我需要从其他Excel文件填充它。。。。基本上从一个文件夹中逐个打开每个文件,然后复制粘贴到主工作簿上。。。我写了一个宏。。但它仍然有一些流量。。。我不知道该怎么做

Option Explicit
Sub fill()

Dim wb As Workbook, wb2 As Workbook, mywb As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range

Set wb = ThisWorkbook
'Application.ScreenUpdating = False
Set mywb = Workbooks("C:\Users\cbensoussan.FGC\Desktop\MASTER FOLDER.xlsx")

sPath = "F:\Blotters\OPT\2014\Jan\"       
sFilename = Dir(sPath & "*.xls*")       

Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename)          

  Range("A2:AO2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    mywb.Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown) + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    wb2.Close False   
    sFilename = Dir

Loop
Application.ScreenUpdating = True

End Sub
感谢您的帮助

诸如此类(未经测试)


你说还是不行。它有什么作用?这有什么用?非常感谢你。。。在
Set mywb=Workbooks(“C:\Users\cbensoussan.FGC\Desktop\MASTER FOLDER.xlsx”)
上,我仍然有一个下标超出范围。。。不知道它是从哪里来的工作簿打开了吗?它需要是(或者您需要在代码中打开它),您只需使用名称引用它。编辑我的答案。。。
Option Explicit
Sub fill()

Dim wb As Workbook, wb2 As Workbook, mywb As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range, rgCopy as range

Set wb = ThisWorkbook
'Application.ScreenUpdating = False

'if not already open:
Set mywb = Workbooks.Open("C:\Users\cbensoussan.FGC\Desktop\MASTER FOLDER.xlsx")
'or if already open:
'Set mywb = Workbooks("MASTER FOLDER.xlsx")

sPath = "F:\Blotters\OPT\2014\Jan\"       
sFilename = Dir(sPath & "*.xls*")       

Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename)          

    with wb2.Activesheet
        Set rgCopy = .Range("A2:AO" & .cells(.rows.count, 1).End(xlUp).Row)
    end with

    mywb.activesheet.cells(rows.count, 1).end(xlUp). _
         Resize(rgCopy.Rows.Count, rgCopy.Columns.Count).Value = rgCopy.Value


    wb2.Close False   
    sFilename = Dir

Loop
Application.ScreenUpdating = True

End Sub