Import specific columns from workbook A sheet1 to workbook B Sheet 2 to specific columns

[Vassen]

Hi,
I was using below codes to import data from same workbook from ws1 to ws2, can someone help to update the code for me to do same but each sheet is in a different workbook
Thanks for your help
Code:

Sub ImportBEMicro()
Dim ws1 As Worksheet, ws2 As Worksheet, lr1 As Long, nr2 As Long, r As Range
Set ws1 = Worksheets("NLM_CDVente"): Set ws2 = Worksheets("NLM_BE_MICRO")
lr1 = ws1.Cells(Rows.Count, "AN").End(xlUp).Row
nr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each r In ws1.Range("AN3:AN" & lr1).Cells
If r.Interior.ColorIndex <> 3 And r.Value <> "" Then
ws2.Range("A" & nr2) = r.Offset(, -39): ws2.Range("B" & nr2) = r.Offset(, -38): ws2.Range("C" & nr2) = r.Offset(, -32): ws2.Range("D" & nr2) = r.Offset(, -24): ws2.Range("E" & nr2) = r.Offset(, -23): ws2.Range("F" & nr2) = r.Offset(, -22): ws2.Range("G" & nr2) = r.Offset(, -21): ws2.Range("H" & nr2) = r.Offset(, -20): ws2.Range("I" & nr2) = r.Offset(, -19): ws2.Range("J" & nr2) = r.Offset(, 17): ws2.Range("K" & nr2) = r.Offset(, 19): ws2.Range("L" & nr2) = r.Offset(, 38): ws2.Range("M" & nr2) = r.Offset(, 39): ws2.Range("N" & nr2) = r.Offset(, -31): ws2.Range("O" & nr2) = r.Offset(, -16): ws2.Range("P" & nr2) = r.Offset(, -15): ws2.Range("Q" & nr2) = r.Offset(, -14): ws2.Range("R" & nr2) = r.Offset(, -12): ws2.Range("S" & nr2) = r.Offset(, -10) 'the letter defines column on the target sheet and the figures defines the position of the columns to be copied compared to column where the x is found'
nr2 = nr2 + 1: r.Value = "": r.Interior.ColorIndex = 3
End If
Next r
End Sub

[Olly]

Edit: Code tags used in next post...

[Vassen]

Dear Olly,
Sorry as I did not know the real format to sent the code.Here it is(Hope it is ok now.

Sub ImportBEMicro()

Dim ws1 As Worksheet, ws2 As Worksheet, lr1 As Long, nr2 As Long, r As Range

Set ws1 = Worksheets("NLM_CDVente"): Set ws2 = Worksheets("NLM_BE_MICRO") 
lr1 = ws1.Cells(Rows.Count, "AN").End(xlUp).Row 
nr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1 
For Each r In ws1.Range("AN3:AN" & lr1).Cells 
If r.Interior.ColorIndex <> 3 And r.Value <> "" Then

ws2.Range("A" & nr2) = r.Offset(, -39): ws2.Range("B" & nr2) = r.Offset(, -38): ws2.Range("C" & nr2) = r.Offset(, -32): ws2.Range("D" & nr2) = r.Offset(, -24): ws2.Range("E" & nr2) = r.Offset(, -23): ws2.Range("F" & nr2) = r.Offset(, -22): ws2.Range("G" & nr2) = r.Offset(, -21): ws2.Range("H" & nr2) = r.Offset(, -20): ws2.Range("I" & nr2) = r.Offset(, -19): ws2.Range("J" & nr2) = r.Offset(, 17): ws2.Range("K" & nr2) = r.Offset(, 19): ws2.Range("L" & nr2) = r.Offset(, 38): ws2.Range("M" & nr2) = r.Offset(, 39): ws2.Range("N" & nr2) = r.Offset(, -31): ws2.Range("O" & nr2) = r.Offset(, -16): ws2.Range("P" & nr2) = r.Offset(, -15): ws2.Range("Q" & nr2) = r.Offset(, -14): ws2.Range("R" & nr2) = r.Offset(, -12): ws2.Range("S" & nr2) = r.Offset(, -10) 'the letter defines column on the target sheet and the figures defines the position of the columns to be copied compared to column where the x is found'

nr2 = nr2 + 1: r.Value = "": r.Interior.ColorIndex = 3
End If
Next r
End Sub

[Olly]

Try this:

Sub ImportBEMicro()

    Dim wb1 As Workbook
    Dim wb2 As Workbook

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Dim lr1 As Long
    Dim nr2 As Long
    
    Dim r As Range

    
    'change workbook values as required.
    Set wb1 = Workbooks("C:\Users\Vassen\Documents\BOOK1.xlsx")
    Set wb2 = Workbooks("C:\Users\Vassen\Documents\BOOK2.xlsx")

    Set ws1 = wb1.Worksheets("NLM_CDVente")
    Set ws2 = wb2.Worksheets("NLM_BE_MICRO")
    
    lr1 = ws1.Cells(Rows.Count, "AN").End(xlUp).Row
    nr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each r In ws1.Range("AN3:AN" & lr1).Cells
        If r.Interior.ColorIndex <> 3 And r.Value <> "" Then
        
            'the letter defines column on the target sheet and
            'the figures defines the position of the columns to
            'be copied compared to column where the x is found
            ws2.Range("A" & nr2) = r.Offset(, -39)
            ws2.Range("B" & nr2) = r.Offset(, -38)
            ws2.Range("C" & nr2) = r.Offset(, -32)
            ws2.Range("D" & nr2) = r.Offset(, -24)
            ws2.Range("E" & nr2) = r.Offset(, -23)
            ws2.Range("F" & nr2) = r.Offset(, -22)
            ws2.Range("G" & nr2) = r.Offset(, -21)
            ws2.Range("H" & nr2) = r.Offset(, -20)
            ws2.Range("I" & nr2) = r.Offset(, -19)
            ws2.Range("J" & nr2) = r.Offset(, 17)
            ws2.Range("K" & nr2) = r.Offset(, 19)
            ws2.Range("L" & nr2) = r.Offset(, 38)
            ws2.Range("M" & nr2) = r.Offset(, 39)
            ws2.Range("N" & nr2) = r.Offset(, -31)
            ws2.Range("O" & nr2) = r.Offset(, -16)
            ws2.Range("P" & nr2) = r.Offset(, -15)
            ws2.Range("Q" & nr2) = r.Offset(, -14)
            ws2.Range("R" & nr2) = r.Offset(, -12)
            ws2.Range("S" & nr2) = r.Offset(, -10)

            nr2 = nr2 + 1
            r.Value = ""
            r.Interior.ColorIndex = 3
        End If
    Next r
End Sub

(why is your code on so few lines, with statements colon separated? It's much easier to read and edit, if statements are on separate lines...)

[Vassen]

Hi Olly,
Many thanks, the way you presented the codes really professional, orderly and easy to understand. Again thanks

[Olly]

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. You may also add reputation to users who helped you. Thanks.