Question

目前，我是研究VBA的新手，我仍在学习中。继续前进，请问对此有什么帮助吗？ :)，我的情况就是这样。

我有20个工作表（POLY，BAYO，PROPO，TIPAS，CITRO .... etc）的数据，工作表名为（Sheet1）
我要复制每个工作簿上的数据并将其粘贴到基于文件名和特定单元格（“ B2：F2”）的各自工作表名称中
可行吗？

这是我正在尝试处理的代码，问题是，它正在创建自己的工作表，而不是将其粘贴到我的愿望表中。

Private Sub CommandButton1_Click()

Dim SourceBook As Workbook   
Dim CurrentBook As Workbook

application.screenupdating = false
Set CurrentBook = ThisWorkbook

Set SourceBook = Workbooks.Open("C:\CITRO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("CITRO").Range("R2:V2")

Set SourceBook = Workbooks.Open("C:\BAYO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("BAYO").Range("R2:V2")

Set SourceBook = Workbooks.Open("C:\PROPO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("PROPO").Range("R2:V2")

MsgBox "Completed"
Application.Workbooks("CITRO").Close
Application.Workbooks("BAYO").Close
Application.Workbooks("PROPO").Close
'SourceBook.Close
'Set SourceBook = Nothing
'Set CurrentBook = Nothing

'ThisWorkbook.Activate
'Application.Worksheets("Summary").Activate
'Application.Worksheets("Summary").Range("B2:F2").Select

End Sub

Answer 1

您需要先关闭SourceBook，然后再使用SourceBook.Close SaveChanges:=False

Private Sub CommandButton1_Click()
    Dim SourceBook As Workbook   
    Dim CurrentBook As Workbook

    Application.ScreenUpdating = False 'don't forget to activate it in the end
    Set CurrentBook = ThisWorkbook

    Set SourceBook = Workbooks.Open("C:\CITRO.xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("CITRO").Range("R2:V2")
    SourceBook.Close SaveChanges:=False

    Set SourceBook = Workbooks.Open("C:\BAYO.xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("BAYO").Range("R2:V2")
    SourceBook.Close SaveChanges:=False

    Set SourceBook = Workbooks.Open("C:\PROPO.xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("PROPO").Range("R2:V2")
    SourceBook.Close SaveChanges:=False

    Application.ScreenUpdating = True        
    MsgBox "Completed"
End Sub

或者，您可以使用一个过程来缩短它：

Private Sub CommandButton1_Click()        
    Application.ScreenUpdating = False 'don't forget to activate it in the end

    CopyIntoThisWorkbook "C:\CITRO.xlsx", "CITRO"
    CopyIntoThisWorkbook "C:\BAYO.xlsx", "BAYO"
    CopyIntoThisWorkbook "C:\PROPO.xlsx", "PROPO"

    Application.ScreenUpdating = True        
    MsgBox "Completed"
End Sub


Private Sub CopyIntoThisWorkbook(ByVal SourceFileName As String, ByVal DestinationSheetName As Range)
    Dim SourceBook As Workbook
    Set SourceBook = Workbooks.Open(SourceFileName)
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=ThisWorkbook.Worksheets(DestinationSheetName).Range("R2:V2")
    SourceBook.Close SaveChanges:=False
End Sub

如果工作表名称CITRO总是文件名CITRO.xlsx，那么您甚至可以使用带有循环的数组：

Private Sub CommandButton1_Click()        
    Application.ScreenUpdating = False 'don't forget to activate it in the end
    Dim SheetNameList() As Variant
    SheetNameList = Array("CITRO", "BAYO", "PROPO") 'easily extendable

    Dim SheetName As Variant
    For Each SheetName In SheetNameList
        CopyIntoThisWorkbook SheetName
    Next SheetName

    Application.ScreenUpdating = True        
    MsgBox "Completed"
End Sub


Private Sub CopyIntoThisWorkbook(ByVal DestinationSheetName As String)
    Dim SourceBook As Workbook
    Set SourceBook = Workbooks.Open("C:\" & DestinationSheetName & ".xlsx")
    SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=ThisWorkbook.Worksheets(DestinationSheetName).Range("R2:V2")
    SourceBook.Close SaveChanges:=False
End Sub

从其他工作簿复制数据并将其粘贴到报表工作簿的特定工作表上

1 个答案: