我正在尝试运行一个非常简单的宏,该宏实际上会打开两个XLS文件,然后从中复制一些范围并将此信息粘贴到目标文件中的另一个范围中。这里的问题是宏运行良好,但是最后一个范围粘贴在“选择”工作表中,而不是在代码中指示的工作表中完成。我不知道发生了什么,因为我有一个克隆工作簿(此处的宏仅在几个范围内变化),并且工作得很好。
Sub CopySheets()
On Error GoTo eh
Dim Path As String
Dim FileA As String
Dim FileB As String
Dim Filename As String
Dim Filename2 As String
Dim SheetSource5 As String
Dim SheetDest5 As String
'Defining Strings
Path = Sheets("Config").Range("C2").Value
FileA = Sheets("Selection").Range("G23").Value
FileB = Sheets("Selection").Range("H23").Value
Filename = Path & FileA & ".xlsx"
Filename2 = Path & FileB & ".xlsx"
SheetSource1 = "MS1"
SheetSource2 = "MS2"
SheetSource3 = "MS3"
SheetSource4 = "MS4"
SheetSource5 = "MS5"
SheetDest1 = "CTO"
SheetDest2 = "EPSO"
SheetDest3 = "ASO"
SheetDest4 = "SO"
SheetDest5 = "GCCO"
'Defining Current Workbook
Set cwb = ThisWorkbook
'First Import
Set wbk = Workbooks.Open(Filename)
wbk.Worksheets(SheetSource1).Range("L8:M117").Copy
cwb.Sheets(SheetDest1).Range("A1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource1).Range("R8:R117").Copy
cwb.Sheets(SheetDest1).Range("C1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource1).Range("W8:W117").Copy
cwb.Sheets(SheetDest1).Range("D1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource2).Range("L8:M117").Copy
cwb.Sheets(SheetDest2).Range("A1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource2).Range("R8:R117").Copy
cwb.Sheets(SheetDest2).Range("C1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource2).Range("W8:W117").Copy
cwb.Sheets(SheetDest2).Range("D1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource3).Range("L8:M117").Copy
cwb.Sheets(SheetDest3).Range("A1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource3).Range("R8:R117").Copy
cwb.Sheets(SheetDest3).Range("C1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource3).Range("W8:W117").Copy
cwb.Sheets(SheetDest3).Range("D1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource4).Range("L8:M117").Copy
cwb.Sheets(SheetDest4).Range("A1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource4).Range("R8:R117").Copy
cwb.Sheets(SheetDest4).Range("C1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource4).Range("W8:W117").Copy
cwb.Sheets(SheetDest4).Range("D1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource5).Range("L8:M117").Copy
cwb.Sheets(SheetDest5).Range("A1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource5).Range("R8:R117").Copy
cwb.Sheets(SheetDest5).Range("C1").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource5).Range("W8:W117").Copy
cwb.Sheets(SheetDest5).Range("D1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
'Second Import
Set wbk = Workbooks.Open(Filename2)
wbk.Worksheets(SheetSource1).Range("L8:M117").Copy
cwb.Sheets(SheetDest1).Range("A112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource1).Range("R8:R117").Copy
cwb.Sheets(SheetDest1).Range("C112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource1).Range("W8:W117").Copy
cwb.Sheets(SheetDest1).Range("D112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource2).Range("L8:M117").Copy
cwb.Sheets(SheetDest2).Range("A112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource2).Range("R8:R117").Copy
cwb.Sheets(SheetDest2).Range("C112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource2).Range("W8:W117").Copy
cwb.Sheets(SheetDest2).Range("D112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource3).Range("L8:M117").Copy
cwb.Sheets(SheetDest3).Range("A112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource3).Range("R8:R117").Copy
cwb.Sheets(SheetDest3).Range("C112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource3).Range("W8:W117").Copy
cwb.Sheets(SheetDest3).Range("D112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource4).Range("L8:M117").Copy
cwb.Sheets(SheetDest4).Range("A112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource4).Range("R8:R117").Copy
cwb.Sheets(SheetDest4).Range("C112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource4).Range("W8:W117").Copy
cwb.Sheets(SheetDest4).Range("D112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource5).Range("L8:M117").Copy
cwb.Sheets(SheetDest5).Range("A112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource5).Range("R8:R117").Copy
cwb.Sheets(SheetDest5).Range("C112").PasteSpecial xlPasteValues
wbk.Worksheets(SheetSource5).Range("W8:W117").Copy
cwb.Sheets(SheetDest5).Range("D112").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Done:
MsgBox "Information loaded!"
Exit Sub
eh:
MsgBox "The following error occurred because XLS structure for selected month is not standard or data does not exist."
End Sub
我已经简化了代码,仅关注SheetDest5
,如下所示,但问题仍然存在:
Sub CopySheets()
On Error GoTo eh
Dim Path As String
Dim FileA As String
Dim FileB As String
Dim Filename As String
Dim Filename2 As String
Dim SheetSource5 As String
Dim SheetDest5 As String
'Defining Strings
Path = Sheets("Config").Range("C2").Value
FileA = Sheets("Selection").Range("G23").Value
FileB = Sheets("Selection").Range("H23").Value
Filename = Path & FileA & ".xlsx"
Filename2 = Path & FileB & ".xlsx"
SheetSource5 = "MS5"
SheetDest5 = "GCCO"
'Defining Current Workbook
Set cwb = ThisWorkbook
'First Import
Set wbk = Workbooks.Open(Filename)
wbk.Worksheets(SheetSource5).Range("L8:M117").Copy
cwb.Sheets("GCCO").Range("A1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
End Sub
答案 0 :(得分:0)
在多次检查代码之后,测试注释中建议的修改,然后我禁用了Excel上运行的所有加载项。最后,行为不当的原因是“ SAP Analysis for Office”,而不是代码。