Unable to copy columns from one file to another (Code not working)

[powerwill]

Wrote a code to copy cells from columns E, F, G, C, H, I, D, from File A to columns A, B, C, D, E, K, L in File B...in the same order.

Whats the catch ?: File A has a Table around 80+ rows with column A having 5 unique values. I am trying to make the code filter the column A to select one unique value and that will be referenced from a cell range in File C (File that has code). Once filtered I need only the visible cells from the specified columns copied over to the columns in File B.

Below is my code that doesn't work for some reason...Any help is appreciated!

Sub CopyDataToFileB()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim rngFilter As Range
    Dim i As Long
    
    'Set the workbooks and worksheets
    Set wbA = Workbooks.Open(Environ("USERPROFILE") & "\TEST FOLDER\FileA.xlsx")
    Set wsA = wbA.Worksheets("Sheet1")
    Set wbB = Workbooks.Open(Environ("USERPROFILE") & "\TEST FOLDER\FileB.xlsx")
    Set wsB = wbB.Worksheets("Sheet1")
    
    'Filter the data in File A based on column F
    wsA.Range("A1").AutoFilter Field:=1, Criteria1:="Sales"
    
    'Get the filtered range
    Set rngFilter = wsA.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    
    'Copy the filtered data to File B
    With wsB
               
        'Copy the data to the destination columns
        For i = 2 To rngFilter.Rows.Count
            .Range("A" & i - 1).Value = rngFilter.Cells(i, 5).Value
            .Range("B" & i - 1).Value = rngFilter.Cells(i, 6).Value
            .Range("C" & i - 1).Value = rngFilter.Cells(i, 7).Value
            .Range("D" & i - 1).Value = rngFilter.Cells(i, 3).Value
            .Range("E" & i - 1).Value = rngFilter.Cells(i, 8).Value
            .Range("K" & i - 1).Value = rngFilter.Cells(i, 9).Value
            .Range("L" & i - 1).Value = rngFilter.Cells(i, 4).Value
        Next i
    End With
    
    'Turn off the filter
    wsA.AutoFilterMode = False
End Sub

 

[Micron]

Step through the code (F8), watch flow and test variables and references in the immediate window after a line is executed.
Examples:
?rngFilter.Address (hit enter at the end of the test line(s)

?rngFilter.Rows.Count
Doesn't work doesn't help. It means what? Code doesn't run? Runs but produces wrong/no result? Raises error message? Something else?

 

[Anthony47]

In addition to Micron suggestion, above...

I would forget about SpecialCells and use instead:

Set rngFilter = WSa.Range("A1").CurrentRegion

For J = 1 To rngFilter.Rows.Count
    If Not rngFilter.Cells(J, 1).EntireRow.Hidden Then            '<<<<<
        With WSb
    
                .Range("A" & I - 1).Value = rngFilter.Cells(I, 5).Value
                .Range("B" & I - 1).Value = rngFilter.Cells(I, 6).Value
                .Range("C" & I - 1).Value = rngFilter.Cells(I, 7).Value
                .Range("D" & I - 1).Value = rngFilter.Cells(I, 3).Value
                .Range("E" & I - 1).Value = rngFilter.Cells(I, 8).Value
                .Range("K" & I - 1).Value = rngFilter.Cells(I, 9).Value
                .Range("L" & I - 1).Value = rngFilter.Cells(I, 4).Value
        End With
    End If
Next J

Note that you might even forget about filtering, if you for example replace the line marked <<< with this one:

    If rngFilter.Cells(J, 1) = "Sales" Then

 

[Anthony47]

The code above misses one key piece: assigning I its correct value:

Set rngFilter = WSa.Range("A1").CurrentRegion

I = 1                                               '<!!!!!!!
For J = 1 To rngFilter.Rows.Count
    If Not rngFilter.Cells(J, 1).EntireRow.Hidden Then
        With WSb
                I = I + 1                           '<!!!!!!!!
                .Range("A" & I - 1).Value = rngFilter.Cells(I, 5).Value

(the two lines marked "<!!!!!")

Sorry

 

[powerwill]

The code above misses one key piece: assigning I its correct value:

Set rngFilter = WSa.Range("A1").CurrentRegion

I = 1                                               '<!!!!!!!
For J = 1 To rngFilter.Rows.Count
    If Not rngFilter.Cells(J, 1).EntireRow.Hidden Then
        With WSb
                I = I + 1                           '<!!!!!!!!
                .Range("A" & I - 1).Value = rngFilter.Cells(I, 5).Value

(the two lines marked "<!!!!!")

Sorry

Thank you @Anthony47 & @Micron for your responses. I tried the suggested code, for some reason it only filtered "sales" and copied the other columns over to FileB even after changing the filtered value, but like you said filtering could be removed, so I re-wrote the below code to lookup the range and copy the cells over whose corresponding cell in Column A meets a certain value, but stumbled on a new problem now....despite asigning 'j' to lookup the next blank row in FileB , my code is overwriting the values in the 2nd Row of File B. Could you kindly take a loot at it ? would really appreciate.

Sub CopyMatchingRows()
    Dim fileA As Workbook, fileB As Workbook
    Dim sheetA As Worksheet, sheetB As Worksheet
    Dim lastRowA As Long, lastRowB As Long
    Dim searchRange As Range, searchValue As Variant
    Dim i As Long, j As Long
 
    'Open both files and assign to variables
    Set fileA = Workbooks.Open(Environ("USERPROFILE") & "\TEST FOLDER\FileA.xlsx")
    Set fileB = Workbooks.Open(Environ("USERPROFILE") & "\TEST FOLDER\FileB.xlsx")
 
    'Set the worksheet objects
    Set sheetA = fileA.Worksheets("Sheet1")
    Set sheetB = fileB.Worksheets("Sheet1")
 
    'Get the last row in both sheets
    lastRowA = sheetA.Range("A" & Rows.Count).End(xlUp).Row
    lastRowB = sheetB.Range("A" & Rows.Count).End(xlUp).Row
 
    'Set the range to search in column A of FileA
    Set searchRange = sheetA.Range("A2:A" & lastRowA)
 
    'Set the value to search for
    searchValue = sheetA.Range("M1").Value
 
    'Loop through each row in searchRange
    For i = 2 To searchRange.Rows.Count
     
        'If the cell value matches the searchValue
        If searchRange.Cells(i, 1).Value = searchValue Then
'
            'Copy the specified cells from FileA to FileB
            j = lastRowB + 1 'next empty row in FileB
         
            With sheetB
                    
            .Range("A" & j) = sheetA.Range("B" & i)
            .Range("B" & j) = sheetA.Range("C" & i)
            .Range("C" & j) = sheetA.Range("E" & i)
            .Range("D" & j) = sheetA.Range("F" & i)
            .Range("E" & j) = sheetA.Range("G" & i)
            .Range("K" & j) = sheetA.Range("H" & i)
            .Range("L" & j) = sheetA.Range("I" & i)
               
            End With
        End If
    Next i

End Sub

 

[powerwill]

Thank you @Anthony47 & @Micron for your responses. I tried the suggested code, for some reason it only filtered "sales" and copied the other columns over to FileB even after changing the filtered value, but like you said filtering could be removed, so I re-wrote the below code to lookup the range and copy the cells over whose corresponding cell in Column A meets a certain value, but stumbled on a new problem now....despite asigning 'j' to lookup the next blank row in FileB , my code is overwriting the values in the 2nd Row of File B. Could you kindly take a loot at it ? would really appreciate.

Sub CopyMatchingRows()
    Dim fileA As Workbook, fileB As Workbook
    Dim sheetA As Worksheet, sheetB As Worksheet
    Dim lastRowA As Long, lastRowB As Long
    Dim searchRange As Range, searchValue As Variant
    Dim i As Long, j As Long
 
    'Open both files and assign to variables
    Set fileA = Workbooks.Open(Environ("USERPROFILE") & "\TEST FOLDER\FileA.xlsx")
    Set fileB = Workbooks.Open(Environ("USERPROFILE") & "\TEST FOLDER\FileB.xlsx")
 
    'Set the worksheet objects
    Set sheetA = fileA.Worksheets("Sheet1")
    Set sheetB = fileB.Worksheets("Sheet1")
 
    'Get the last row in both sheets
    lastRowA = sheetA.Range("A" & Rows.Count).End(xlUp).Row
    lastRowB = sheetB.Range("A" & Rows.Count).End(xlUp).Row
 
    'Set the range to search in column A of FileA
    Set searchRange = sheetA.Range("A2:A" & lastRowA)
 
    'Set the value to search for
    searchValue = sheetA.Range("M1").Value
 
    'Loop through each row in searchRange
    For i = 2 To searchRange.Rows.Count
    
        'If the cell value matches the searchValue
        If searchRange.Cells(i, 1).Value = searchValue Then
'
            'Copy the specified cells from FileA to FileB
            j = lastRowB + 1 'next empty row in FileB
        
            With sheetB
                   
            .Range("A" & j) = sheetA.Range("B" & i)
            .Range("B" & j) = sheetA.Range("C" & i)
            .Range("C" & j) = sheetA.Range("E" & i)
            .Range("D" & j) = sheetA.Range("F" & i)
            .Range("E" & j) = sheetA.Range("G" & i)
            .Range("K" & j) = sheetA.Range("H" & i)
            .Range("L" & j) = sheetA.Range("I" & i)
              
            End With
        End If
    Next i

End Sub

Nevermind @Anthony47 I realised, "lastRowB = lastRowB + 1" was missin that fixed the code. Thank you.