对不同的工作表重复操作

Question

新手来了！对于特定的工作簿或特定的工作表，我有一个想要重复的操作。

有没有办法在不复制和粘贴第二、第三等工作表的整个代码的情况下做到这一点？ 只有工作簿和工作表名称会更改。其他操作（例如复制粘贴）保持不变。

虽然有一个“For Each 循环”，但我不知道如何以一种允许我准确指定哪些工作表的方式进行操作。

例如，我是

• 步骤 1：从工作簿“Red”表“Apple”复制数据。粘贴到输出 工作簿。
• 重复操作。第 2 步：从工作簿“黄色”表“香蕉”中复制数据。粘贴到 相同的输出工作簿。

如果有人可以提供建议，这是我的代码。 VBA新手在这里谢谢你！

Sub CopyPastefromOtherWB()

Range("B13").Select

    'Activate WB1
            Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Red"

            Worksheets("Apple").Activate

            Range("A1").Select

            Do While Selection.Value <> "Mar"
            ActiveCell.Offset(0, 1).Select

            Loop

            ActiveCell.Offset(1, 0).Select
            Range(ActiveCell, ActiveCell.End(xlDown)).Select
            Selection.Copy

    'Activate output notebook
            Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
            Worksheets("Sheet1").Activate
            Range("B13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'HERE IS WHERE THE REPEAT HAPPENS. Activate WB2
            Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Yellow"

            Worksheets("Banana").Activate

            Range("A1").Select

            Do While Selection.Value <> "Mar"
            ActiveCell.Offset(0, 1).Select

            Loop

            ActiveCell.Offset(1, 0).Select
            Range(ActiveCell, ActiveCell.End(xlDown)).Select
            Selection.Copy

    'Activate output notebook
            Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
            Worksheets("Sheet1").Activate
            Range("C13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    ActiveCell.Offset(0, 1).Select
            
End Sub

Answer 1

经过几个月的学习，我开发了一个解决方案，您可以随意使用下面的代码并根据您的需要进行调整。此解决方案适用于一组单元格。

Sub copypaste_adhoc()

    Dim inputfile As Workbook
    
    Set inputfile = Workbooks.Open("c:\path\workbook")

    Dim arrSht, i
    arrSht = Array("worksheet1", "worksheet2")
                
                        
        For i = LBound(arrSht) To UBound(arrSht)
        
            With Worksheets(arrSht(i))
                                
            .Range("A31:Z31").Copy
            
            ThisWorkbook.Sheets("Sheet1").Cells(Sheet5.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            
                                    
            End With
            Next i

                           
            Application.CutCopyMode = False
        
    
    Sheet5.Range("a1").CurrentRegion.EntireColumn.AutoFit
    
End Sub

Answer 2

请参阅How to avoid using Select in Excel VBA。

Sub CopyPastefromOtherWB(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetCell As Range)
    With Workbooks.Open(FromPath)
        With .Worksheets(FromSheetName)
            Dim c As Range
            Set c = .Rows(1).Find("Mar", LookAt:=xlWhole).Offset(1, 0)
          
            TargetCell.Resize(c.Rows.Count, 1).Value = .Range(c, c.End(xlDown)).Value
        End With
    
        .Close False
    End With
End Sub

With Workbooks.Open("C:\Users\Desktop\My macro projects\OutputWB").Worksheets("Sheet1")
    CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Red", "Apple", .Range("B13")
    CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Yellow", "Banana", .Range("C13")
End With