VBA PasteSpecial - cant paste values from columns

[mysticmario]

Hi good people of mrexcel board

Trying to go through all the sheets select colums D and E and paste their value to another sheet.
Initially i wanted to do it without activating the sheets since I have 90+ sheets but so far I cant even make it work with this code.
The problem is with lr and paste values
can someone help me to fix it?

Private Sub CommandButton1_Click()
Dim lr As Long
Dim lr2 As Long
Dim wsSheet As Worksheet
    For Each wsSheet In Worksheets
        If InStr(wsSheet.Name, "Invoices") Then
        lr = Sheets("SUMMARY MENU").Cells(Rows.Count, "D").End(xlUp).Row
        wsSheet.Activate
ActiveSheet.Range("D:D").Select
        Selection.Copy
        Sheets("SUMMARY MENU").Cells(lr + 1, "D").PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("E:E").Select
        Selection.Copy
        Sheets("SUMMARY MENU").Cells(lr2 + 1, "E").PasteSpecial Paste:=xlPasteValues
        End If
Next wsSheet

End Sub

 

[kokano90]

let me know when u get it so I can delete it form here, it's not a file that should be shared publicly

I watched it. You can delete it. Could you please attach the code you wrote so I can fix it. Because we don't speak the same language. so i can only guess what you mean

 

[mysticmario]

I watched it. You can delete it. Could you please attach the code you wrote so I can fix it. Because we don't speak the same language. so i can only guess what you mean

Which of the codes.
The one i wrote to copy data is here.

Private Sub CommandButton1_Click()
Dim lr As Long
Dim lr2 As Long
Dim wsSheet As Worksheet
    For Each wsSheet In Worksheets
        If InStr(wsSheet.Name, "Faktury") Then
        lr = Sheets("PANEL PODLICZEŃ").Cells(Rows.Count, "D").End(xlUp).Row
        lr2 = Sheets("PANEL PODLICZEŃ").Cells(Rows.Count, "E").End(xlUp).Row
        wsSheet.Activate
ActiveSheet.Range("D:D").Select
        Selection.Copy
        Sheets("PANEL PODLICZEŃ").Cells(lr + 1, "D").PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("E:E").Select
        Selection.Copy
        Sheets("PANEL PODLICZEŃ").Cells(lr2 + 1, "E").PasteSpecial Paste:=xlPasteValues
        End If
Next wsSheet

End Sub

 

[mysticmario]

the button that has this code attached is here: Sheets("PANEL PODLICZEŃ")
and sheets that for loop should go through always look like: Faktury11225, Faktury120221 etc.

 

[kokano90]

the button that has this code attached is here: Sheets("PANEL PODLICZEŃ")
and sheets that for loop should go through always look like: Faktury11225, Faktury120221 etc.

Sub ABC()
    Dim iRow&,  lR&,Ws As Worksheet
    For Each Ws In Worksheets
        If InStr(Ws.Name, "Faktury") Then
            iRow = Sheets("PANEL PODLICZEŃ").Range("D" & Rows.Count).End(3).Row + 1
            lR = Ws.Range("D" & Rows.Count).End(3).Row
            Ws.Range("D6:D" & lR).Resize(, 2).Copy
            Sheets("PANEL PODLICZEŃ").Range("D" & iRow).PasteSpecial xlPasteValues
        End If
    Next
End Sub

 

[kokano90]

Edit code

Sub ABC()
    Dim iRow&, lR&,Ws As Worksheet
    For Each Ws In Worksheets
        If InStr(Ws.Name, "Faktury") Then
            iRow = Sheets("PANEL PODLICZEŃ").Range("D" & Rows.Count).End(3).Row + 1
            lR = Ws.Range("D29").End(3).Row
            If lR > 6 Then
                Ws.Range("D6:D" & lR).Resize(, 2).Copy
                Sheets("PANEL PODLICZEŃ").Range("D" & iRow).PasteSpecial xlPasteValues
            End If
        End If
    Next
End Sub

 

[mysticmario]

Sub ABC()
    Dim iRow&,  lR&,Ws As Worksheet
    For Each Ws In Worksheets
        If InStr(Ws.Name, "Faktury") Then
            iRow = Sheets("PANEL PODLICZEŃ").Range("D" & Rows.Count).End(3).Row + 1
            lR = Ws.Range("D" & Rows.Count).End(3).Row
            Ws.Range("D6:D" & lR).Resize(, 2).Copy
            Sheets("PANEL PODLICZEŃ").Range("D" & iRow).PasteSpecial xlPasteValues
        End If
    Next
End Sub

Works amazingly thank you, this code is definately not on my level

 

[kokano90]

Works amazingly thank you, this code is definately not on my level

I don't know much English. Can only guess what you mean. Is that right or not. Please check it yourself

 

[mysticmario]

It works. Thanks
I modified it a bit.
Now i need to add code to delete from column D and E not used data such us:
"#REF"
"SUMA(NETTO):"
"Data do:"
"Data od:"
"Data"
So the dates is the only thing left

 

[mysticmario]

Private Sub test_click()
Dim cell As Range
Dim rng As Range
Set rng = ActiveSheet.Columns("D:D")
rng.Select
For Each cell In rng
Set cell = Selection.Find(what:="SUMA(NETTO):", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
cell.Select
      
 

Next


End Sub

I want this code to grab all the"SUMA(NETTO):" cells and offset cells to the right not just first, and then delete them with shift=xlUp