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]

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!

Let's try it without the formatting part. Let's make sure it's getting the copy range across first:

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
End Sub

 

[jalrs]

Let's try it without the formatting part. Let's make sure it's getting the copy range across first:

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
End Sub

Yes it works! For all the departments, as i replicated the code for them! Ill mark as solution as im sending this message.
Ill get back to you. Im preparing some attachments, so i can better explain myself!

 

[jalrs]

Ok so, let's make this easy.

For "DEP1" department i have 27 entries.
For "DEP2" department i have 254 entries
For "DEP3" department i have 2 entries
For "DEP4" department i have 482 entries.

Names in " " are just example names.

So all departments are copied correctly according to the macro.
Lets focus on row 220. The row when the template gets broken. For context, row 220 is the last row that my template uses when i create a new sheet with the same template.

Problem here is, as for departments that i have more than 220 entries, here shown as DEP2 and DEP4, the columns from AX to BC dont keep copying the format until last record of data from WB1 is found. (1)

Also for context, They are intended to be blank at the moment. They are supposed to fill after the filtered data for each department is copied.

And for DEP1 and DEP3, departments that i have less than 220 entries, i would like to delete the extra rows, so just keep the essential. For dep1, keep 28 rows(counting with header on row 1 + 27 rows of data entries), for DEP3 keep 3 rows (header row + 2 rows of data entries) (2)

For DEP2 and DEP4 we assure this already, i mean, that we don't have any extra empty rows, don't know why tho. (3)

 

[kevin9999]

If it was my project, I'd be using Conditional Formatting, especially as you're not talking about thousands of rows, just hundreds. See the demo below. I've deliberately left some cells in column AW blank to demonstrate what's possible. And obviously, you can apply the CF to as many rows as you like. They'll remain blank unless column AW contains something. The gridlines may still appear below, but they do not appear in the actual sheet.

CF Demo.xlsx
	AW	AX	AY	AZ	BA	BB	BC
1	Col AW	Col AX	Col AY	Col AZ	Col BA	Col BB	Col BC
2	Data
3	Data
4	Data
5	Data
6
7
8	Data
9	Data
10
11
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
AY2:AY10	Expression	=$AW2<>""	text	NO
AX2:AX10	Expression	=$AW2<>""	text	NO
AW2:BC10	Expression	=$AW2<>""	text	NO

 

[jalrs]

Ill try it, thank you so much kevin!

 

[jalrs]

If it was my project, I'd be using Conditional Formatting, especially as you're not talking about thousands of rows, just hundreds. See the demo below. I've deliberately left some cells in column AW blank to demonstrate what's possible. And obviously, you can apply the CF to as many rows as you like. They'll remain blank unless column AW contains something. The gridlines may still appear below, but they do not appear in the actual sheet.

CF Demo.xlsx
	AW	AX	AY	AZ	BA	BB	BC
1	Col AW	Col AX	Col AY	Col AZ	Col BA	Col BB	Col BC
2	Data
3	Data
4	Data
5	Data
6
7
8	Data
9	Data
10
11
Sheet1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
AY2:AY10	Expression	=$AW2<>""	text	NO
AX2:AX10	Expression	=$AW2<>""	text	NO
AW2:BC10	Expression	=$AW2<>""	text	NO

Ok so after trying it, i dont think that CF is what i need. i just pushed the lines down until row 1000 for example, and its enough for the work i want.
For closing the thread, i would just need a line of code, to clear all the rows after data is inserted that are empty, so for the end user, the layout stays more user friendly.

is it possible by any means within vba and not CF?

Thanks Kevin

 

[kevin9999]

Ok so after trying it, i dont think that CF is what i need. i just pushed the lines down until row 1000 for example, and its enough for the work i want.
For closing the thread, i would just need a line of code, to clear all the rows after data is inserted that are empty, so for the end user, the layout stays more user friendly.

is it possible by any means within vba and not CF?

Thanks Kevin

I'll suggest some code to clear the superfluous lines (tomorrow my time zone ?)

 

[jalrs]

I'll suggest some code to clear the superfluous lines (tomorrow my time zone ?)

Ok see you tomorrow Kevin! Good night and Thanks!

 

[kevin9999]

I've added a couple of lines of code to the end of the sub that should clear any unused rows. Please try it & let me know how it goes for you.

Option Explicit
Sub jalrs5()
    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 = Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
    ws2.Range("A" & lr2 & ":A1001").EntireRow.Delete
    
End Sub

 

[jalrs]

I've added a couple of lines of code to the end of the sub that should clear any unused rows. Please try it & let me know how it goes for you.

Option Explicit
Sub jalrs5()
    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 = Cells.Find("*", , xlFormulas, , 1, 2).Row + 1
    ws2.Range("A" & lr2 & ":A1001").EntireRow.Delete
   
End Sub

Good morning Kevin (timezones )

It did work for first department, when i assigned it to all department buttons, it stopped working. what happened was, for example department 2 has 254 entries, and it only returned 31 rows, happened the same for all the other departments

thanks!