excel 遍历文件夹，对于每个文件，将特定单元格复制到主控形状，并将每个单元格另存为单独的工作簿

von4xj4u 于 2023-01-10 发布在其他

关注(0)|答案(1)|浏览(165)

我一直在尝试找到一个解决方案来循环大量文件的任务。我用我的代码成功地处理了一个文件，但是当我添加循环时，它没有通过第一个副本。
我想达到的目的是：
我在一个文件夹中有100个文件。我想循环遍历该文件夹并处理每个文件，将特定单元格复制到主文件“master_file. xlsx”中，然后将主文件以. xlsx的文件名保存在不同的目录中。

Sub creation2()

Dim myPath As String
Dim Rcd As String
Dim Wb As String
Dim Bs As Workbook

    myPath = "C:\Users\test\"
    Rcd = Dir(myPath & "*") 
    Wb = "x" & Rcd
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
    
    Do While Rcd <> ""
    
    Workbooks.Open Rcd
    Set Bs = Workbooks.Open(myPath & "master_File.xlsx")
    Bs.SaveAs Filename:="C:\Users\test\new\" & Wb
    Workbooks(Rcd).Worksheets(Rcd).Range("A2").Copy
    Workbooks(Wb).Worksheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    Workbooks(Rcd).Worksheets(Rcd).Range("C3").Copy
    Workbooks(Wb).Worksheets("Data").Range("A4").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    Workbooks(Rcd).Worksheets(Rcd).Range("E2").Copy
    Workbooks(Wb).Worksheets("Data").Range("A2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    Workbooks(Rcd).Worksheets(Rcd).Range("E4:I210").Copy
    Workbooks(Wb).Worksheets("Data").Range("A7").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    

    Workbooks(Wb).Worksheets("Data").Range("A1").Activate
    ActiveWorkbook.Close SaveChanges:=True
       
    Rcd = Dir
    
Loop    
End Sub

作为VBA的初学者，我一直在调整我的代码，我有一种感觉，有些地方是不正确的。

excel

来源：https://stackoverflow.com/questions/75022416/looping-through-folder-and-for-every-file-copy-specific-cell-to-a-master-and-sa

1条答案

按热度按时间

798qvoo81#

Sub creation2()

Dim myPath As String
Dim Rcd As String
Dim Wb As String
Dim Bs As Workbook

    myPath = "C:\Users\test\"
    Rcd = Dir(myPath & "*")

    Set Bs = Workbooks.Open(myPath & "master_File.xlsx")
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
    
    Do While Rcd <> ""
    
        Wb = "x" & Rcd
        Bs.SaveAs Filename:="C:\Users\test\new\" & Wb
        
        Workbooks.Open Rcd
        
        Workbooks(Rcd).Worksheets(Rcd).Range("A2").Copy
        Workbooks(Wb).Worksheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        Workbooks(Rcd).Worksheets(Rcd).Range("C3").Copy
        Workbooks(Wb).Worksheets("Data").Range("A4").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        Workbooks(Rcd).Worksheets(Rcd).Range("E2").Copy
        Workbooks(Wb).Worksheets("Data").Range("A2").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        Workbooks(Rcd).Worksheets(Rcd).Range("E4:I210").Copy
        Workbooks(Wb).Worksheets("Data").Range("A7").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        
        Workbooks(Wb).Worksheets("Data").Range("A1").Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Save
        Application.DisplayAlerts = True
           
        Rcd = Dir
    
    Loop
    ActiveWorkbook.Close SaveChanges:=True
    
End Sub

赞(0）回复(0）举报 2023-01-10

我来回答

excel 遍历文件夹，对于每个文件，将特定单元格复制到主控形状，并将每个单元格另存为单独的工作簿

1条答案

相关问题

热门标签

最新问答