从文件夹中的所有文件将特定的命名工作表复制到工作簿

时间:2018-11-13 15:41:34

标签: excel vba import copy spreadsheet

我要在这里实现的是将特定的命名工作表从不同的工作簿复制到将要使用的主工作簿。

我不确定我对“ IF”陈述的理解。如果我在endif上使用断点逐步运行代码,则会得到想要的结果,即从文件夹中的每个文件的每个IF语句中命名的每个工作表,但是如果我正常运行,我的代码只会通过通过第一个IF语句,然后切换文件。我将获得文件夹中每个文件的第一个工作表...有人可以为我提供解决方案的建议吗?

顺便说一句,我知道我可以在一个for循环中执行IF语句,我只是尝试在循环之前逐步遵循它。我也尝试过等待一段时间,以防错误是在打开文件或其他东西的时候出现的,但是看起来不像这样...

Sub Import_Files()

Dim MyFolder As String, MyFile As String

With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show
   MyFolder = .SelectedItems(1)
   Err.Clear
End With

'stops screen updating, calculations, events, and status bar updates to help code run faster
'It'll be opening and closing many files so this will prevent the screen from displaying that

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'This section will loop through and open each file in the folder selected
'and then close that file before opening the next file

Set sThisBk = ActiveWorkbook
MyFile = Dir(MyFolder & "\", vbNormal)

Do While MyFile <> ""
    DoEvents
    'On Error GoTo 0
    Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
    'Application.Wait (Now + TimeValue("0:00:15"))
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If SheetExists("ANALYSE E 000002") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000002")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000003") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000003")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000004") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000004")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000005") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000005")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000006") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000006")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000007") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000007")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000008") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000008")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000009") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000009")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000010") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000010")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000011") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000011")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE E 000012") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE E 000012")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000002") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000002")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000003") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000003")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000004") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000004")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000005") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000005")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000006") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000006")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000007") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000007")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000008") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000008")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000009") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000009")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000010") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000010")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000011") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000011")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    If SheetExists("ANALYSE F30 000012") Then
        Set wsSht = Workbooks(MyFile).Sheets("ANALYSE F30 000012")
        wsSht.Copy Before:=sThisBk.Sheets("ENDOFFILE")
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '0
    Workbooks(MyFile).Close SaveChanges:=False
    MyFile = Dir
Loop

'turns settings back on that was turned off before looping folders

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual

End Sub


Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

谢谢

1 个答案:

答案 0 :(得分:0)

主要问题是您的函数import QtQuick 2.11 // <--- import QtQuick.Controls 1.4 // <--- ApplicationWindow { id: mainWindow visible: true title: "MainWindow" width: 640 height: 480 menuBar: MenuBar { id: menuBar Menu { id: editMenu title: "&Edit" MenuItem { id: copyItem text: "Copy" shortcut: StandardKey.Copy onTriggered: console.log("copy") } } } } 不知道需要在哪个工作簿中搜索。因此,它需要一个参数供工作簿查看。

SheetExists

然后,我建议定义一个工作表名称列表,应复制该工作表名称才能使用循环:

Private Function SheetExists(ByVal SheetName As String, Optional InWorkbook As Workbook) As Boolean
    Dim sht As Object

    If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook 'default to ThisWorkbook 

    On Error Resume Next
    Set sht = InWorkbook.Sheets(SheetName)
    SheetExists = Not sht Is Nothing
    On Error Goto 0 'either this or Err.Clear is needed
End Function

然后将打开的工作簿设置为变量以方便访问:

Dim ListOfSheetNames As Variant
ListOfSheetNames = Array("ANALYSE E 000002", "ANALYSE E 000003") 'add more sheet names here

最后遍历工作表名称列表,测试工作表名称是否存在于您打开的工作簿中,并将其复制到Dim OpenedWorkbook As Workbook Set OpenedWorkbook = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False) (运行此代码的工作簿)。

ThisWorkbook

最后,您可以使用

关闭打开的工作簿。
Dim SheetName As Variant
For Each SheetName In ListOfSheetNames 'loop through all sheet names in the list
    If SheetExists(SheetName, OpenedWorkbook) Then 'test if sheet name exists in the opened workbook
        OpenedWorkbook.Sheets(SheetName).Copy Before:=ThisWorkbook.Sheets("ENDOFFILE")
    End If
Next SheetName