为什么我的宏都会拉出所有列

时间:2018-01-11 18:59:40

标签: excel vba excel-vba

关于为什么我的宏无效,我有一个简单的问题。我不知道vba,但我想我要求它拉P14:S,但它将所有列A14:结束到我收集数据的主表中。我是这样做的:

Sub Consolidate()
    'Author:     Jerry Beaucaire'
    'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
    'Summary:    Merge files in a specific folder into one master sheet (stacked)
    '            Moves imported files into another folder
    ' Edited/altered by me

    Dim fName As String, fPath As String, fPathDone As String
    Dim LR As Long, NR As Long
    Dim wbData As Workbook, wsMaster As Worksheet

    'Setup
    Application.ScreenUpdating = False           'speed up macro execution
    Application.EnableEvents = False             'turn off other macros for now
    Application.DisplayAlerts = False            'turn off system messages for now

    Set wsMaster = ThisWorkbook.Sheets("Master") 'sheet report is built into

    With wsMaster
        If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
            .UsedRange.Offset(1).EntireRow.Clear
            NR = 2
        Else
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
        End If

        'Path and filename (edit this section to suit)
        fPath = "C:\Users\jc\Desktop\Test\"      'remember final \ in this string"
        fPathDone = fPath & "Imported\"          'remember final \ in this string
        On Error Resume Next
        MkDir fPathDone                          'creates the completed folder if missing
        On Error GoTo 0
        fName = Dir(fPath & "New BM Analysis test.xlsm") 'listing of desired files, edit filter as desired

        'Import a sheet from found files
        Do While Len(fName) > 0
            If fName <> ThisWorkbook.Name Then   'don't reopen this file accidentally
                Set wbData = Workbooks.Open(fPath & fName) 'Open file

                'This is the section to customize, replace with your own action code as needed
                LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
                Range("P14:S" & LR).Copy .Range("A" & NR)
                wbData.Close False               'close file
                NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
                'Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
            End If
            fName = Dir                          'ready next filename
        Loop
    End With

ErrorExit:                                       'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True             'turn system alerts back on
    Application.EnableEvents = True              'turn other macros back on
    Application.ScreenUpdating = True            'refreshes the screen
End Sub

有谁知道为什么我要求的列没有被拉?可能是我问错了。

0 个答案:

没有答案