繁体   English   中英

我正在编写一个宏以从一个工作簿复制到另一个工作簿,但出现错误

[英]I am writing a macro to copy from one workbook to another and I am getting an error

我在下面编写VBA宏,并且在我希望文件路径中的工作表为活动工作表的地方不断出现错误。 我已经能够编写代码来打开工作表。 现在,我需要将表单复制到另一个表单。 请帮忙

Dim Templatepath As String
Dim CurrentFile As String
Dim cells As Range
Dim SourceWorkBook As Workbook
Dim FilesName As Range

Dim SheetToReplace As String
Dim SheetToCopy As String
Dim OpenTitle As String
Dim FileToOpen As String
Dim FileName As String

'Get the default Template path and change to it.
        Templatepath = ThisWorkbook.Sheets("Actual Opex From QRA").Range("Q1").Value
        FilePathLength = Len(Templatepath)
         FilePathLength = FilePathLength - 1
         Templatepath = Left(Templatepath, FilePathLength)
         FilePathLength = FilePathLength - 1
         Templatepath = Right(Templatepath, FilePathLength)


   'to make the file active
For Each FilesName In Worksheets("Actual Opex From QRA").Range("Q2:Q4")

If FilesName.Value <> "" Then

            CurrentSheetName = FilesName.Value
            TemplateName = FilesName + ".xlsx"
TemplateLocation = Templatepath + "\" + TemplateName

    Application.EnableEvents = False
            Application.DisplayAlerts = False
            Application.ScreenUpdating = False

Workbooks.Open (TemplateLocation)



   Windows(TemplateName).Activate
   Set SourceWorkBook = ActiveWorkbook
    With ActiveWorkbook
    Sheets("QRA Download").Activate
    ActiveSheet.Range("D2:D199902").Select
    Application.CutCopyMode = False
    Selection.Copy

    'paste the data in the current location

   CurrentFile = ActiveWorkbook.Name

   Windows(CurrentFile).Activate
    ActiveSheet.Range("c9:c199902").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False



 End With
 End If
 Next

 End Sub

我的下标超出范围错误

这是解决方案的开始,在您提供反馈时可能需要对其进行完善

Sub DoStuff()

    Dim Templatepath As String
    Dim CurrentFile As String
    Dim cells As Range
    Dim SourceWorkBook As Workbook
    Dim FilesName As Range

    Dim SheetToReplace As String
    Dim SheetToCopy As String
    Dim OpenTitle As String
    Dim FileToOpen As String
    Dim FileName As String

    'Get the default Template path and change to it.
    Templatepath = ThisWorkbook.Sheets("Actual Opex From QRA").Range("Q1").Value
    FilePathLength = Len(Templatepath)
    FilePathLength = FilePathLength - 1
    Templatepath = Left(Templatepath, FilePathLength)
    FilePathLength = FilePathLength - 1
    Templatepath = Right(Templatepath, FilePathLength)

    '' Variables for keeping track opened files,worksheets, and ranges
    Dim openedWB As Workbook
    Dim srcSheet As Worksheet
    Dim srcRange As Range

    For Each FilesName In Worksheets("Actual Opex From QRA").Range("Q2:Q4")
        If FilesName.Value <> "" Then

            CurrentSheetName = FilesName.Value
            TemplateName = FilesName + ".xlsx"
            TemplateLocation = Templatepath + "\" + TemplateName

            '' Commented out due to being a small task
            '' Good practice though for longer running Macros
            'Application.EnableEvents = False
            'Application.DisplayAlerts = False
            'Application.ScreenUpdating = False


            '' Keep track of your opened workbook with a variable
            Set openedWB = Workbooks.Open(TemplateLocation)

            '' No need to activate now that we are accessing it through a variable
            ''Windows(TemplateName).Activate
            Set SourceWorkBook = ActiveWorkbook

            With openedWB
                'Sheets("QRA Download").Activate
                '' Added a period to utilize the 'With' Statement
                '' Saved to a variable instead of activating it
                '' I'm also guessing this is where the Error was happening
                Set srcSheet = .Sheets("QRA Download")

                ''ActiveSheet.Range("D2:D199902").Select
                ''If you are looking to get the whole column there's a better way - 'D:D'
                Set srcRange = srcSheet.Range("D:D") '' if D2:D199902 is intentional feel free to change it

                ''' We are going to bypass the clipboard altogether
                'Application.CutCopyMode = False
                'Selection.Copy

                'paste the data in the current location

                '' By CurrentFile did you intend for that to be the workbook with this code in it or some other workbook?
                '' The way it was originally coded you would be activating Windows(TemplateName) again
                '' due to the line Windows(TemplateName).Activate and then CurrentFile = ActiveWorkbook.Name

                'CurrentFile = ActiveWorkbook.Name

                '' I'm not sure where you wanted to copy this
                '' So I'm having it copied to the currently active sheet for now
                ActiveSheet.Range("C:C").Value = srcRange.Value

             End With
         End If
     Next

 End Sub

暂无
暂无

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

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