Question

我在下面编写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

我的下标超出范围错误

Answer 1

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False 'best to turn this off to avoid a loop
    '!! Note that if code errors before this gets back to being set to True
    'you will need to run code to set this to True somewhere for this event
    'to be be set to be triggered again.

    If Target.Address = Range("A1:A15").Address And IsNumeric(Me.Range("B1")) Then
        'Selects E1 to whatever row is in cell B1

        Range(Me.Range("E1"), Me.Range("E1").Offset(Me.Range("B1").Value, 0)).Select


    ElseIf Not Intersect(Target, Range("A:A")) Is Nothing Then
        'This would automatically shift the selection from WHATEVER
        'is in column a to column E

        Intersect(Target.EntireRow, Me.Range("E:E")).Select

    ElseIf Not Intersect(Target, Range("C:C")) Is Nothing Then
        'This will take the top cell in a selection in column E and then select
        'corresponding row in column E along with the additional rows specificed in cell B1

        Intersect(Target.Cells(1, 1).EntireRow, Me.Range("E:E")).Resize(Me.Range("B1").Value, 1).Select

    End If

    Application.EnableEvents = True 'Turns events back on when done
End Sub

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

1 个答案: