不在Z列之后復制資料

我有一個包含 A:AA 列資料的電子表格。我正在嘗試將“作業簿-a”中的 CycleCountResearch 作業表中的所有資料復制到“作業簿-b”中的 CycleCountResearch 作業表中。除了列 AA 副本的所有資料都結束了。AA 列包含檔案名，因此當它從作業簿 a 復制到作業簿 b 時，用戶可以查看作業簿 b 中的資料并知道資料來自哪個檔案。是否有關于如何修復 AA 列而不是復制的建議？

這是到目前為止的代碼：

       Sub Export()
    Dim FileName As String
        FileName = "\\InventoryControlDatabase\DoNotOpen\DoNotOpenDCAtest.xlsx"
    'Call function to check if the file is open
        If IsFileOpen(FileName) = False Then
        Application.ScreenUpdating = False
        Worksheets("CycleCountResearch").Unprotect "123"
        Dim LR As Long
        Dim src As Workbook
        LR = Worksheets("CycleCountResearch").Cells(Rows.Count, "B").End(xlUp).Row
        Set src = Workbooks.Open("\\InventoryControlDatabase\DoNotOpen\DoNotOpenDCAtest.xlsx")
        ThisWorkbook.Worksheets("CycleCountResearch").AutoFilterMode = False
        ThisWorkbook.Worksheets("CycleCountResearch").Range("A4:AA" & LR).AutoFilter Field:=23, Criteria1:="Done", _
              Operator:=xlFilterValues
        On Error Resume Next
        ThisWorkbook.Worksheets("CycleCountResearch").Range("A5:AA" & LR).SpecialCells(xlCellTypeVisible).Copy
        src.Activate
        src.Worksheets("CycleCountResearch").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'src.Worksheets("CycleCountCompleted").UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes
        Workbooks("DoNotOpenDCA.xlsx").Close SaveChanges:=True
        Application.ScreenUpdating = True
       
        Call UpdateMasterLog
        Call ClearUpdates
        ThisWorkbook.Worksheets("CycleCountResearch").Range("K2:K2").ClearContents
        'Clears the name of the user editing the sheet
        Else
            MsgBox "Someone else is saving.  Please wait a moment and try again"
            Exit Sub
        End If
    
    End Sub

uj5u.com熱心網友回復：

資料備份

• 這就是我的看法。在運行它之前通讀它，因為您可能需要重新排列Finishing Touches部分中的一些行（例如ClearUpdates，UpdateMasterLogs）。
• 最好的建議應該是關于使用變數。他們不會減慢代碼，但將使其更具可讀性，明顯的例子是變數srg，sdrg和sdfrg。

Option Explicit

Sub ExportData()
    
    Const dFilePath As String _
        = "\\InventoryControlDatabase\DoNotOpen\DoNotOpenDCAtest.xlsx"
    
    'Call function to check if the file is open
    If Not IsFileOpen(dFilePath) Then ' source workbook is closed
        
        Application.ScreenUpdating = False
        
        ' Source
        
        Dim swb As Workbook: Set swb = ThisWorkbook
        Dim sws As Worksheet: Set sws = swb.Worksheets("CycleCountResearch")
        sws.Unprotect "123"
        sws.AutoFilterMode = False
        Dim slRow As Long: slRow = sws.Range("B" & sws.Rows.Count).End(xlUp).Row
        ' Source Range (has headers)
        Dim srg As Range: Set srg = sws.Range("A4:AA" & slRow)
        srg.AutoFilter Field:=23, Criteria1:="Done" ' '23' is 'W'
        ' Source Data Range (no headers)
        Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)
        ' Source Data Filtered Range
        Dim sdfrg As Range
        On Error Resume Next ' prevent error if no cells
            Set sdfrg = sdrg.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not sdfrg Is Nothing Then
            
            ' Destination
            
            Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
            Dim dws As Worksheet: Set dws = dwb.Worksheets("CycleCountResearch")
            Dim dCell As Range
            Set dCell = dws.Range("A" & dws.Rows.Count).End(xlUp).Offset(1)
            
            sdfrg.Copy?
            dCell.PasteSpecial Paste:=xlPasteValues
            'dwb.Worksheets("CycleCountCompleted").UsedRange.RemoveDuplicates _
                Columns:=1, Header:=xlYes
            dwb.Close SaveChanges:=True
            
            ' Finishing Touches
        
            UpdateMasterLog
            ClearUpdates
            'Clear the name of the user editing the sheet
            sws.Range("K2:K2").ClearContents
            
            sws.AutoFilterMode = False
            sws.Protect "123"
            
            Application.ScreenUpdating = True '
            
            MsgBox "Data exported.", vbInformation
            
        Else ' no filtered data
               
            sws.AutoFilterMode = False
            MsgBox "No filtered data.", vbCritical
            'Exit Sub
               
        End If
            
    Else ' source workbook is open
        
        MsgBox "Someone else is saving. Please, try again later.", vbExclamation
        'Exit Sub
        
    End If

End Sub

標籤：擅长 vba

上一篇：AccessVBA中的IsError()

下一篇：使用多個作業表匯入多個Excel檔案-范圍問題