对不同的工作表重复操作

Question

这里是新手！对于特定的工作簿或特定的工作sheets.

，我有一个我想重复的动作

有没有办法不用复制和粘贴第二个、第三个等工作的整个代码sheet？只有工作簿和工作 sheet 名称发生变化。其他操作（例如复制粘贴）保持不变。

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

例如，我是

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

如果有人可以提供建议，这是我的代码。 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

请参阅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

Answer 2

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

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

对不同的工作表重复操作

Repeat action for different worksheets

excel

vba

loops

repeat