简体   繁体   English

使用单元格作为复制内容的指导在工作簿之间复制工作表

[英]Copying a worksheet between workbooks using cells as guidance on what to copy

I have the following in Call.xlsm, A2 contains the path to a second Workbook, Data.xlsm.我在 Call.xlsm 中有以下内容,A2 包含第二个工作簿 Data.xlsm 的路径。 A3 holds the sheetname I'm trying to copy from Data.xlsm to Call.xlsm. A3 包含我试图从 Data.xlsm 复制到 Call.xlsm 的工作表名称。

在此处输入图像描述

I understand the first step to copying a sheet from another workbook, is to open it the other workbook (this is in Call.xlsm):我了解从另一个工作簿复制工作表的第一步是将其打开另一个工作簿(在 Call.xlsm 中):

Sub GetData()
    Dim filenameIS As String
    filenameIS = Worksheets("Sheet1").Range("a2")
    Workbooks.Open (filenameIS)
    
    Workbooks(filenameis).WorkSheets("Data 2018").CopyBefore:=ThisWorkbook.Sheets(1))

End Sub

This returns:这将返回:

Compile error: Synatax error编译错误:语法错误

It doesn't like the:=它不喜欢:=

Try this:尝试这个:

Sub GetData()
    Dim filenameIS As String, wb As Workbook, wsInfo As Worksheet
    
    Set wsInfo = ThisWorkbook.Worksheets("Sheet1")
    filenameIS = wsInfo.Range("a2")
    
    Set wb = Workbooks.Open(filenameIS) 'get a reference to the opened workbook
    'Copy the worksheet named in A3 over to `wb`
    wb.Worksheets(wsInfo.Range("A3").Value).Copy _
         Before:=ThisWorkbook.Worksheets(1) 

End Sub

Import Sheet From Closed Workbook从关闭的工作簿导入工作表

Sub ImportSheet()
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("Sheet1")
    
    Dim sFilePath As String: sFilePath = CStr(dws.Range("A2").Value)
    Dim sSheetName As String: sSheetName = CStr(dws.Range("A3").Value)
    
    Dim IsFound As Boolean
    IsFound = CreateObject("Scripting.FileSystemObject").FileExists(sFilePath)
    
    If Not IsFound Then
        MsgBox "The file '" & sFilePath & "' doesn't exist.", vbExclamation
        Exit Sub
    End If
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
     
    Dim sws As Object ' if it's a worksheet, use 'Dim sws As Worksheet'
    On Error Resume Next
        Set sws = swb.Sheets(sSheetName)
    On Error GoTo 0
    
    If Not sws Is Nothing Then sws.Copy Before:=dwb.Sheets(1)
    
    swb.Close SaveChanges:=False
    
    If sws Is Nothing Then
        MsgBox "Sheet '" & sSheetName & "' doesn't exist.", vbExclamation
    Else
        MsgBox "Sheet '" & sSheetName & "' imported.", vbInformation
    End If
    
End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM