Question

我在VBA中比较新，目前我正在研究Master_file.xlsm中的一个宏，它包含多个数据范围，这些数据必须填充文件夹中的几个.xlsb个文件。

工作表Control包含A2文件夹路径，其中包含要填充的所有.xlsb个文件，以及D个文件名列。

工作表Churn在第A列包含相同的文件名，后面是要在.xlsb文件中粘贴的相应范围。

到目前为止，这就是我所拥有的一切。

Sub Fill_NNAs()

  Dim FilePath As String
  Dim iCell As String
  Dim BC As String

  Application.EnableCancelKey = xlDisabled
  Application.ScreenUpdating = False

  ActiveWorkbook.Sheets("Control").Activate
  LastRow = Range("D2").End(xlDown).Row
  intRowCount = LastRow
  FilePath = ActiveSheet.Range("A2").Value

  For i = 2 To intRowCount
    iCell = Cells(i, 4).Value
    BC = Cells(i, 3).Value
    Worksheets("Churn").Activate
    Columns("A:A").Select
    x = Selection.Find(What:=BC, After:=ActiveCell,     LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(3, 64)).Select
    Selection.Copy
    Workbooks.Open FileName:=FilePath & iCell, ReadOnly:=False,     UpdateLinks:=0
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    Sheets("Summary_ARD").Select
    Range("C89:BN91").Select
    ActiveSheet.Paste
    ActiveWindow.Close SaveChanges:=True
    Workbooks("Master_file.xlsm").Activate
    Sheets("Control").Select

  Next

  MsgBox "Completed successfully!"

End Sub

如您所见，我的循环转到工作表Control，获取第一个文件名，在Churn上搜索，复制其各自的范围，打开Filename.xlsb，激活{{ 1}}表格，粘贴它然后转到下一个。

它一直很好，但现在我遇到了一个新问题：

某些Summary_ARD个文件包含多个“Summary_ARD”表格，例如xlsb，Summary_ARD，Summary_ARD (2)，有些则有Summary_ARD (3)张而不是{ {1}}。

因此，我的代码在打开新的New_ARD时必须做的是：

激活括号中数字最大的Summary_ARD（Summary_ARD（5）而不是（4）等）。
如果没有工作表Filename.xlsb，请激活Summary_ARD。
如果没有工作表Summary_ARD (number)，请激活Summary_ARD。
对于上述所有，它必须只在可见的纸张中查看。

有什么想法吗？

Answer 1

如果您的目标工作表是WB中的最后一张工作表，您可以通过其.index编号引用它 - 最后一个是sheets.count -

哦，我重新构建了您的代码，因此您没有使用.selection或.activate

Sub Fill_NNAs()
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False

Dim wbDest As Workbook
Dim FilePath As String
FilePath = ActiveSheet.Range("A2").Value

Dim iCell As String
Dim BC As String

Dim rngSearch As Range

Dim lastrow As Integer
lastrow = Range("D2").End(xlDown).Row

Dim wsControl As Worksheet
wsControl = ThisWorkbook.Sheets("Control")

Dim wsChurn As Worksheet
wsChurn -ThisWorkbook.Sheets("Churn")


For i = 2 To lastrow
    iCell = wsControl.Cells(i, 4).Value
    BC = wsControl.Cells(i, 3).Value

Set rngSearch = wsChurn.Columns(1).Find(What:=BC, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)


Set rngSearch = Range(rngSearch.Offset(1, 1), rngSearch.Offset(3, 64))


Workbooks.Open Filename:=FilePath & iCell, ReadOnly:=False, UpdateLinks:=0
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever

ActiveWorkbook.Sheets(Sheets.Count).Range("C89:BN91") = rngSearch

ActiveWindow.Close SaveChanges:=True

Next

MsgBox "Completed successfully!"

End Sub

否则，您可能需要使用类似的东西 -

Sub testb()
Dim j As Integer
j = 0
Dim wsDest As Worksheet

For Each ws In ThisWorkbook.Sheets
    If InStr(1, ws.Name, "(") Then
        If Mid(ws.Name, InStr(1, ws.Name, "(") + 1, 1) > j Then
            j = Mid(ws.Name, InStr(1, ws.Name, "(") + 1, 1)
        End If
    End If
Next

    If j = 0 Then
        If SheetExists("Summary_ARD") Then
            wsDest = ThisWorkbook.Sheets("Summary_ARD")
            Else: wsDest = ThisWorkbook.Sheets("New_ARD")
            GoTo label
        End If
    End If

    Set wsDest = ActiveWorkbook.Sheets("Summary_ARD(" & j & ")")
label:
 'do stuff with wsdest

End Sub

Function SheetExists(strWSName As String) As Boolean
    Dim ShTest As Worksheet
    On Error Resume Next
    Set ShTest = Worksheets(strWSName)
    If Not ShTest Is Nothing Then SheetExists = True
End Function

要找到工作表的循环，这可能会起作用

Sub findsheet()
Dim i As Integer
Dim shTest As Worksheet

For i = 1 To 20
On Error GoTo label
Set shTest = Worksheets("Summary_ARD(" & i & ")")

Next
label:
    If i > 1 Then
        Set shTest = Worksheets("Summary_ARD(" & i - 1 & ")")
        GoTo label3
    End
On Error GoTo label2
    Set shTest = Worksheets("Summary_ARD")
    GoTo label3

label2:
    Set shTest = Worksheets("New_ARD")
    GoTo label3

label3:
'do stuff

End Sub

Answer 2

我不知道我是否愚蠢（可能），但我只是将你的循环放在我的旧表格的位置（＆＃34; Summary_ARD＆＃34;）。选择，它不起作用。我被困在＆＃34;标签＆＃34;线。

    Sub Fill_NNAs()

    Dim FilePath As String
    Dim iCell As String
    Dim BC As String

    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False

    ActiveWorkbook.Sheets("Control").Activate
    LastRow = Range("D2").End(xlDown).Row
    intRowCount = LastRow
    FilePath = ActiveSheet.Range("A2").Value

    For i = 2 To intRowCount
    iCell = Cells(i, 4).Value
    BC = Cells(i, 3).Value
   Worksheets("Churn").Activate
   Columns("A:A").Select
    x = Selection.Find(What:=BC, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(3, 64)).Select
    Selection.Copy Workbooks.Open FileName:=FilePath & iCell, ReadOnly:=False,     UpdateLinks:=0 ActiveWorkbook.UpdateLinks = xlUpdateLinksNever

    On Error GoTo label
    Set shTest = Worksheets("Summary_ARD(" & i & ")")

    Next
    label:
    If i > 2 Then
        Set shTest = Worksheets("Summary_ARD(" & i - 1 & ")")
        GoTo label3
    End
    On Error GoTo label2
    Set shTest = Worksheets("Summary_ARD")
    GoTo label3

    label2:
    Set shTest = Worksheets("New_ARD")
    GoTo label3

    label3:
    Range("C89:BN91").Select
    ActiveSheet.Paste
    ActiveWindow.Close SaveChanges:=True
    Workbooks("Master_file.xlsm").Activate
    Sheets("Control").Select

    Next

    MsgBox "Completed successfully!"

    End Sub

对不起，我没有使用您重新编写的代码。

从主文件输入数据到多个工作表，为每个工作表选择特定工作表

2 个答案: