怎么用VBA,把一个Excel里的部分区域复制到指定文件夹里的每个工作簿里的每个工作表里的每个指定单元格

2024-11-01 08:41:24
有1个网友回答
网友(1):

答:

Sub CopyToFile()
    Dim Wb As Workbook, sFile As String
    Dim Rng As Range, C As Range
    Dim FirstAddress As String
    Dim Sht As Worksheet
    
    sPath = ThisWorkbook.Path & "\测试文件夹\"
    sFile = Dir(sPath & "*.xls*")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Rng = Sheets("名字1").Range("C1:D4")
    Do While sFile <> ""
        Set Wb = Workbooks.Open(sPath & sFile)
        For Each Sht In Wb.Worksheets
            With Sht
                Set C = .UsedRange.Find(what:="总计", lookat:=xlWhole)
                If Not C Is Nothing Then
                    FirstAddress = C.Address
                    Do
                        Rng.Copy C.Offset(0, 1)
                        Set C = .UsedRange.FindNext(C)
                    Loop While Not C Is Nothing And C.Address <> FirstAddress
                End If
            End With
        Next Sht
        Wb.Close savechanges:=True
        sFile = Dir
    Loop
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub