宏打开文件,然后从一个工作表复制并粘贴到另一个工作表 - 宏文件中指定的文件名

时间:2014-09-08 16:03:09

标签: excel vba excel-vba

我是这个论坛的新手,所以如果我不知道某事,请告诉我。

假设我不是VBA编程的专业人士,我想请教一些我正在尝试构建的宏的帮助。

这是它应该做的:

1.根据宏文件单元格B6中指定的名称查找文件夹中的“BS”文件 2.根据宏文件单元格B10中指定的名称查找文件夹中的“AL”文件 3.Copy来自BS工作表(其名称与文件本身完全相同)并将其粘贴到名为“BS”的AL文件工作表中

它可以打开文件但是在复制和粘贴数据时我会得到一个超出范围的下标。所以我非常坚持这一点,我不明白为什么它超出范围,因为我仔细检查并且工作表名称匹配

我在代码中添加的注释的更多信息。

欢迎任何建议!

Sub opencopypaste()     
    Dim strFNameBS As String 
    Dim strFNameAL As String
    Dim SourceBSfilename As String
    Dim DestALfilename As String
    Dim SourceBSwkb As Workbook
    Dim DestALwkb As Workbook
    Dim SourceBSsheet As Worksheet
    Dim DestALsheet As Worksheet

    strFNameBS = ThisWorkbook.Worksheets("test").Range("B6").Value
    'macro looks up for the file with name and path indicated in cell B6 of the macro file
    If FileExists(strFNameBS) Then
    'macro checks if the file exists
    If Not BookOpen(Dir(strFNameBS)) Then Workbooks.Open filename:=strFNameBS
    'if not already open, macro opens it
    Else
    MsgBox "The file does not exist!"
    End If
    strFNameAL = ThisWorkbook.Worksheets("test").Range("B10").Value
    'macro looks up for the file with name and path indicated in cell B10 of the macro file
    If FileExists(strFNameAL) Then
    'macro checks if the file exists
    If Not BookOpen(Dir(strFNameAL)) Then Workbooks.Open filename:=strFNameAL, Password:="Carnaval"
    'if not already open, macro opens it
    Else
    MsgBox "The file does not exist!"
    End If
    Set SourceBSwkb = Workbooks(strFNameBS)
    SourceBSsheet(SourceBSwkb) = ThisWorkbook.Worksheets("test").Range("B15").Value
    'workbook from which data will be copied is the BS file indicated above. Worksheet is the one 
    indicated on Cell B15 ("BS xx.xx.xxxx")
    SourceBSsheet.Copy

    Set DestALwkb = Workbooks(strFNameAL)
    DestALsheet(DestALwkb) = ThisWorkbook.Worksheets("test").Range("B17").Value
    'workbook on which data will be copied over is the AL file indicated above. Worksheet is the one 
    indicated on Cell B17 ("BS")
    DestALsheet.PasteSpecial
End Sub

Function FileExists(strfullname As String) As Boolean
    FileExists = Dir(strfullname) <> ""
End Function

Function BookOpen(strWBName As String) As Boolean
    Dim wbk As Workbook
    On Error Resume Next
    Set wbk = Workbooks(strWBName)
    If Not wbk Is Nothing Then BookOpen = True
End Function

0 个答案:

没有答案