I've got a spreadsheet with data from column A:AA. I'm trying to copy over all of the data from sheet CycleCountResearch in "workbook-a" to CycleCountResearch sheet in "workbook-b". All of the data except for column AA copy's over. Column AA contains the filename, so that when it is copied over from workbook a to workbook b, the user can look at the data in workbook b and know which file the data came from. Is there any recommendation on how to fix column AA not copying over?

Here is the code so far:

       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

CodePudding user response：

Backup Data

• This is how I see it. Read through it before running it because you may have to rearrange some lines in the Finishing Touches part (e.g. ClearUpdates, UpdateMasterLogs).
• The best advice from it should be about using variables. They will not slow down the code but will make it more readable, the obvious example being the variables srg, sdrg, and 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