Filtering from one workbook, pasting into another

[jalrs]

Hello guys,

I'm new to VBA and therefore i need some help. I would be glad if i found it here.
So, my problem is: I runned a code after doing my search here, but the code misses on something, after i did my changes and debug it. Im filtering from a sheet called "Stock Trânsito" in Workbook1 to paste on a sheet called "pendentes" on a workbook called "STTApoioSP". When i run the code, instead of pasting into cell "A2" it pastes into cell "A21" and brings a value that doesnt match the criteria filter.

My code:

Sub filterAPOIOSP()

ThisWorkbook.Worksheets("Stock Trânsito").Activate

Dim lastrow As Long, lastrow2 As Long

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastrow2 = Workbooks("STTApoioSP.xlsm").Sheets("pendentes").Cells(Rows.Count, "A").End(xlUp).Row

With ActiveSheet.Range("A6:AV" & lastrow)
.AutoFilter Field:=46, Criteria1:="Apoio SP", Operator:=xlFilterValues
.SpecialCells(xlCellTypeVisible).Copy Workbooks("STTApoioSP.xlsm").Worksheets("pendentes").Range("A2" & lastrow2)

End With

ActiveSheet.AutoFilterMode = False

End Sub


Additional questions:
1- If i want to add criteria2, how should i add it into the code?
2- how can i add a specific column from my workbook to this new one? i mean, where do i write it on the code?

thanks in advance!

 

[kevin9999]

OK. Try the following & see if it gives you what you're looking for. The code is run from the AnaliseST.xlsm workbook, and the STTApoioSP.xlsm is aleady open at the time of running the code.

Option Explicit
Sub jalrs2()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("STTApoioSP")
    
    Set ws1 = wb1.Worksheets("Stock Trânsito")
    Set ws2 = wb2.Worksheets("pendentes")
    
    Dim lr1 As Long, lr2 As Long
    lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1
    
    With ws1.Range("A6:AV" & lr1)
        .AutoFilter 46, "Apoio SP"
        .AutoFilter 47, "in transit"
        .Offset(1).Copy ws2.Cells(lr2, 1)
        With ws1.Range("BH7:BH" & lr1)
           .Copy ws2.Cells(2, 49)
        End With
        .AutoFilter
    End With
End Sub

 

[jalrs]

OK. Try the following & see if it gives you what you're looking for. The code is run from the AnaliseST.xlsm workbook, and the STTApoioSP.xlsm is aleady open at the time of running the code.

Option Explicit
Sub jalrs2()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("STTApoioSP")
 
    Set ws1 = wb1.Worksheets("Stock Trânsito")
    Set ws2 = wb2.Worksheets("pendentes")
 
    Dim lr1 As Long, lr2 As Long
    lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1
 
    With ws1.Range("A6:AV" & lr1)
        .AutoFilter 46, "Apoio SP"
        .AutoFilter 47, "in transit"
        .Offset(1).Copy ws2.Cells(lr2, 1)
        With ws1.Range("BH7:BH" & lr1)
           .Copy ws2.Cells(2, 49)
        End With
        .AutoFilter
    End With
End Sub

Ok so on your code i came to subscript out of range on "set wb2 " so i added ".xlsm" and it was good to go
Also i changed Range ("BH7:BH") to ("BH6:BH") because Headers are on Row5 on WB1, and as you can see on the attachmente, i have the headers sorted already, so don't need to copy them, but only the filtered values. didnt mention it before because thats a small change i could make myself, like i did.

If its still needed, i can make a bogus one, so its easier to sort i believe. could have done it now already, but i think we are on the same page. if not ill make one!

what i got: (unititledJALRS)
what i need: (untitled)

one thing that might have not be clear on my side: BH column from first workbook should only copy the filtered values, so the values that concern "ApoioSP" and are "In transit".

code:
Option Explicit

Sub jalrs()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("STTApoioSP.xlsm")

Set ws1 = wb1.Worksheets("Stock Trânsito")
Set ws2 = wb2.Worksheets("pendentes")

Dim lr1 As Long
Dim lr2 As Long

lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1

With ws1.Range("A6:AV" & lr1)
.AutoFilter 46, "ApoioSP"
.AutoFilter 47, "in transit"
.Offset(1).Copy ws2.Cells(lr2, 1)

With ws1.Range("BH6:BH" & lr1)
.Copy ws2.Cells(2, 49)
End With
.AutoFilter

End With
End Sub

 

[kevin9999]

Ok so on your code i came to subscript out of range on "set wb2 " so i added ".xlsm" and it was good to go
Also i changed Range ("BH7:BH") to ("BH6:BH") because Headers are on Row5 on WB1, and as you can see on the attachmente, i have the headers sorted already, so don't need to copy them, but only the filtered values. didnt mention it before because thats a small change i could make myself, like i did.

If its still needed, i can make a bogus one, so its easier to sort i believe. could have done it now already, but i think we are on the same page. if not ill make one!

what i got: (unititledJALRS)
what i need: (untitled)

one thing that might have not be clear on my side: BH column from first workbook should only copy the filtered values, so the values that concern "ApoioSP" and are "In transit".

code:
Option Explicit

Sub jalrs()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Set wb1 = ThisWorkbook
Set wb2 = Workbooks("STTApoioSP.xlsm")

Set ws1 = wb1.Worksheets("Stock Trânsito")
Set ws2 = wb2.Worksheets("pendentes")

Dim lr1 As Long
Dim lr2 As Long

lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1

With ws1.Range("A6:AV" & lr1)
.AutoFilter 46, "ApoioSP"
.AutoFilter 47, "in transit"
.Offset(1).Copy ws2.Cells(lr2, 1)

With ws1.Range("BH6:BH" & lr1)
.Copy ws2.Cells(2, 49)
End With
.AutoFilter

End With
End Sub

OK. I made a couple of small adjustments to the code, tested it, and it worked for me. See how it goes for you.
Take your time responding if you like - I'm about to go offline for the night.

Option Explicit
Sub jalrs3()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("STTApoioSP.xlsm")
    
    Set ws1 = wb1.Worksheets("Stock Trânsito")
    Set ws2 = wb2.Worksheets("pendentes")
    
    Dim lr1 As Long, lr2 As Long
    lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1
    
    With ws1.Range("A5:AV" & lr1)
        .AutoFilter 46, "Apoio SP"
        .AutoFilter 47, "in transit"
        .Offset(1).Copy ws2.Cells(lr2, 1)
        With ws1.Range("BH6:BH" & lr1)
           .Copy ws2.Cells(2, 49)
        End With
        .AutoFilter
    End With
End Sub

 

[jalrs]

Works great! Thank you so much!

Final questions regarding the output:

1-Noticed that if i click run macro for x amount of times, it will copy the output for the next empty row that x amount of times, is there a way to prevent this? its like if i double click as a mistake ill get the output duplicated to the first empty row that the macro finds

2- For "ApoioSP" and "em tratamento" i have 27 records, i abused of the 1st question "bug" until the last row with format i had as templated. question is, is there anyway that the format keeps flowing all the way down and doesnt stop on row 220? notice that my pre-set template was customized until row 220, and for columns prior to AW he just keeps reloading, while i think it should reload for all columns

i think the attachment is clear for both 1st and 2nd questions. if not, let me know, ill try to explain myself better. thanks again and good night kevin!

 

[kevin9999]

Works great! Thank you so much!

Final questions regarding the output:

1-Noticed that if i click run macro for x amount of times, it will copy the output for the next empty row that x amount of times, is there a way to prevent this? its like if i double click as a mistake ill get the output duplicated to the first empty row that the macro finds

2- For "ApoioSP" and "em tratamento" i have 27 records, i abused of the 1st question "bug" until the last row with format i had as templated. question is, is there anyway that the format keeps flowing all the way down and doesnt stop on row 220? notice that my pre-set template was customized until row 220, and for columns prior to AW he just keeps reloading, while i think it should reload for all columns

i think the attachment is clear for both 1st and 2nd questions. if not, let me know, ill try to explain myself better. thanks again and good night kevin!

In answer to your questions:
1. You/we could get the code to clear out any existing data on the "pendentes" sheet before copying new data to it? That way, the data wouldn't continuously 'grow' at each button press.
2. Conditional formatting is one possibility, although I would prefer a VBA approach - have the code copy the formats from (say) row 2 to the full used range after the data has been copied?

 

[jalrs]

In answer to your questions:
1. You/we could get the code to clear out any existing data on the "pendentes" sheet before copying new data to it? That way, the data wouldn't continuously 'grow' at each button press.
2. Conditional formatting is one possibility, although I would prefer a VBA approach - have the code copy the formats from (say) row 2 to the full used range after the data has been copied?

Hello Kevin! Sorry for late answer!

1-Yes, exactly like a command like cells.clearcontents i would say? when i re-run the macro the first thing its to clear contents. i feel like i should add it on the beginning of the code right?
2-Yes. id say so, from row 2 all the day down. here i actually have no clue how to proceed

Thanks and enjoy rest of the weekend!

 

[kevin9999]

Hello Kevin! Sorry for late answer!

1-Yes, exactly like a command like cells.clearcontents i would say? when i re-run the macro the first thing its to clear contents. i feel like i should add it on the beginning of the code right?
2-Yes. id say so, from row 2 all the day down. here i actually have no clue how to proceed

Thanks and enjoy rest of the weekend!

Regarding question 1, a simple line of code to fix that problem would be:

ws2.UsedRange.Offset(1).ClearContents

placed immediately after the line

Set ws2 = wb2.Worksheets("pendentes")

Regarding question 2, I'm not 100% clear yet on what you need. At the moment, the copy procedure from the AnaliseST workbook to the STTApoioSP workbook will be overwriting any existing formats on the second workbook. So do you mean that you want to ensure the formats on the AnaliseST workbook go down to cover all the data being copied before the copy operation?

 

[jalrs]

Regarding question 1, a simple line of code to fix that problem would be:

ws2.UsedRange.Offset(1).ClearContents

placed immediately after the line

Set ws2 = wb2.Worksheets("pendentes")

Regarding question 2, I'm not 100% clear yet on what you need. At the moment, the copy procedure from the AnaliseST workbook to the STTApoioSP workbook will be overwriting any existing formats on the second workbook. So do you mean that you want to ensure the formats on the AnaliseST workbook go down to cover all the data being copied before the copy operation?

Good morning Kevin, Let's use untitledpng2 as a reference.

Before answering the 1st question, when i re-run macro, the data would copy all the way down like shown there. it also shows there, that after row 220, columns AW-AZ lose their template, while the ones before AW all get the same template as for the rows above 220, including it.

This has nothing to do with AnaliseST workbook tho, since templates are different within workbooks.

It's like if i have more than 220 rows of data here on STTApoioSP, columns AW-AZ would be empty filled, like blank square as shown.
Another way of solving this would be deleting all rows not used after running the macro?

Thank You

 

[kevin9999]

Good morning Kevin, Let's use untitledpng2 as a reference.

Before answering the 1st question, when i re-run macro, the data would copy all the way down like shown there. it also shows there, that after row 220, columns AW-AZ lose their template, while the ones before AW all get the same template as for the rows above 220, including it.

This has nothing to do with AnaliseST workbook tho, since templates are different within workbooks.

It's like if i have more than 220 rows of data here on STTApoioSP, columns AW-AZ would be empty filled, like blank square as shown.
Another way of solving this would be deleting all rows not used after running the macro?

Thank You

OK, try the following code. I think the first addition (deleting existing data on the "pendentes" sheet) works fine - just need to know that the copy-format part is giving you what you want.

Option Explicit
Sub jalrs4()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("STTApoioSP.xlsm")
    
    Set ws1 = wb1.Worksheets("Stock Trânsito")
    Set ws2 = wb2.Worksheets("pendentes")
    
    ws2.UsedRange.Offset(1).ClearContents
    
    Dim lr1 As Long, lr2 As Long
    lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1
    
    With ws1.Range("A5:AV" & lr1)
        .AutoFilter 46, "Apoio SP"
        .AutoFilter 47, "in transit"
        .Offset(1).Copy ws2.Cells(lr2, 1)
        With ws1.Range("BH6:BH" & lr1)
           .Copy ws2.Cells(2, 49)
        End With
        .AutoFilter
    End With
    
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row
    ws2.Rows("2").Copy
    ws2.Rows("2:" & lr2).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    
End Sub

 

[jalrs]

OK, try the following code. I think the first addition (deleting existing data on the "pendentes" sheet) works fine - just need to know that the copy-format part is giving you what you want.

Option Explicit
Sub jalrs4()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("STTApoioSP.xlsm")
   
    Set ws1 = wb1.Worksheets("Stock Trânsito")
    Set ws2 = wb2.Worksheets("pendentes")
   
    ws2.UsedRange.Offset(1).ClearContents
   
    Dim lr1 As Long, lr2 As Long
    lr1 = ws1.Cells(Rows.Count, 1).End(3).Row
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 1
   
    With ws1.Range("A5:AV" & lr1)
        .AutoFilter 46, "Apoio SP"
        .AutoFilter 47, "in transit"
        .Offset(1).Copy ws2.Cells(lr2, 1)
        With ws1.Range("BH6:BH" & lr1)
           .Copy ws2.Cells(2, 49)
        End With
        .AutoFilter
    End With
   
    lr2 = ws2.Cells(Rows.Count, 1).End(3).Row
    ws2.Rows("2").Copy
    ws2.Rows("2:" & lr2).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
   
End Sub

hello Kevin!

i tried it, and this code gives me the following output as attached. on this attachment we did lose the format, as well as the copy range from workbook 1.

Thank you!