Question

我正在尝试从文件夹中的文件复制固定的列，我仅提取N列并将其粘贴到一个活动工作表中，各列彼此相邻。但是，我收到错误消息，请帮助我

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim Filepath As String 
    Dim Wb As Workbook, _ 
        Ws As Worksheet, _ 
        PasteRow As Long 

    Filepath = "\\123.20.0.89\Risk_dept\" 
    Set Ws = ActiveSheet 
    Application.DisplayAlerts = False 
    Application.ScreenUpdating = False 


    MyFile = Dir(Filepath) 
    Do While Len(MyFile) > 0 
       If MyFile = "zmaster.xlsm" Then 
         Exit Sub 
        End If 

    PasteCloumn = Ws.Range("A" & Ws.Columns.Count).End(xlToRight).Column + 1 
    Set Wb = Workbooks.Open(Filepath & MyFile) 
    Worksheets("part 5").Range("N2:N200").Copy 
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A:A").End(xlToRight).Column + 1 
      Applicaiotn.CutCopyMode = False 
  MyFile = Dir 

Loop 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 

End Sub

Answer 1

这对我有用。从文件夹中的文件中提取N列，并将其粘贴到活动工作表中。

Sub LoopThroughDirectory()
    Dim filePath As String, target As Worksheet, file As String, wb As Workbook, col As Long

    filePath = "\\123.20.0.89\Risk_dept\" 
    Set target = ActiveSheet

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

        file = Dir(filePath)

        Do While Len(file) > 0

            If file = "zmaster.xlsm" Then
                Exit Sub
            End If

            Set wb = Workbooks.Open(filePath & file)

            col = target.Range("A1").End(xlToRight).Column + 1
            wb.Worksheets("part 5").Range("N2:N200").Copy Destination:=target.Cells(1, col)

        file = Dir

        Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

将固定的列复制并粘贴到彼此相邻的主表中

1 个答案: