Copying from Filtered range

youbitto

youbitto

New Member
Joined
Jun 8, 2022
Messages
34
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
Hello
I have this code to copy a specific rang to another sheet will be saved as PDF after each filtered value

after execute it shows me an error

This is the code
VBA Code: 
Sub Enq()

Dim Ref As Range

Application.ScreenUpdating = False

lastrow = Sheets("TB").Cells(Rows.Count, "F").End(xlUp).Row
lastrowf = Sheets("Factures").Cells(Rows.Count, "F").End(xlUp).Row

    Dim rngSrc As Range
    Dim arrRef As Variant

Set rngSrc = Sheets("TB").Range("A5:A" & lastrow)
        arrRef = rngSrc.Value2

For i = 5 To lastrow


Sheets("Enq").Range("C20:I42,L20:Q42").ClearContents
Sheets("Enq").Range("C14:Q14").ClearContents
Sheets("Enq").Range("K16:Q16").ClearContents
Sheets("Enq").Range("D17:P17").ClearContents
Sheets("Enq").Range("F18:I18").ClearContents


    Sheets("TB").Cells(i, 2).Copy                                 'Nom
    Sheets("Enq").Range("K16").PasteSpecial Paste:=xlPasteValues
 
    Sheets("TB").Cells(i, 3).Copy                                 'Adresse
    Sheets("Enq").Range("D17").PasteSpecial Paste:=xlPasteValues
 
    Sheets("TB").Cells(i, 4).Copy                                 'Date Résil
    Sheets("Enq").Range("F18").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
    Sheets("TB").Range("G" & i & ":U" & i).Copy             'Ref                   'Ref
    Sheets("Enq").Range("C14").PasteSpecial Paste:=xlPasteValues
 
     'Filter rows based on Ref
    Sheets("Factures").Range("A1:AI" & lastrowf).AutoFilter
    Sheets("Factures").Range("A1:AI" & lastrowf).AutoFilter Field:=18, Criteria1:=arrRef(i - 4, 1)
 
    'Copy filtered table and paste it in Destination cells.
   
    Sheets("Factures").Range("E2:E24").SpecialCells(xlCellTypeVisible).Copy
   
    Sheets("Enq").Range("C20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
     
    Sheets("Factures").Range("O2:O24").SpecialCells(xlCellTypeVisible).Copy
   
    Sheets("Enq").Range("G20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
   
   
    Sheets("Factures").Range("E25:E46").SpecialCells(xlCellTypeVisible).Copy
   
    Sheets("Enq").Range("L20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  
   
    Sheets("Factures").Range("O25:O46").SpecialCells(xlCellTypeVisible).Copy
   
    Sheets("Enq").Range("O20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
   
   
    Application.CutCopyMode = False


Next i

Sheets("Factures").AutoFilterMode = False


Application.ScreenUpdating = True






End Sub



This is the filter Criteria1

Fiche d'enquette.xlsm
A
4Référence
5017051500050157
6017051502408156
7017051503018136
TB




This is the where the I copy from filtered data

Fiche d'enquette.xlsm
EOR
1Date FacturationMontantRéférence
208/11/2022369,22017051500050157
313/05/2023369,22017051500050157
412/08/2023369,22017051500050157
510/10/2023246,15017051500050157
609/11/20202386,59017051502408156
708/05/2021585,8017051502408156
807/08/2021795,33017051502408156
908/11/2021963,87017051502408156
1007/02/2022585,8017051502408156
1108/05/20221269,06017051502408156
1207/08/2022585,8017051502408156
1308/11/2022415,37017051502408156
1416/04/2023276,91017051502408156
1507/02/20222894,93017051503018136
1608/05/202212017,48017051503018136
1707/08/2022415,37017051503018136
1808/11/2022415,37017051503018136
1912/02/2023415,37017051503018136
2016/04/2023276,91017051503018136
Factures



And this is where I paste the filtered data and it has to be in this range
Fiche d'enquette.xlsm
CDEFGHIJKLMNOPQ
19PériodeMontant (DA)PériodeMontant (DA)
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Enq



the error that show is "No cells were found"
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Sort by date Sort by votes
It is not possible for us to reasonably test your code to investigate since it refers to many cells/ranges/columns that are not shown in your XL2BB samples. For example
  • lastrow is determined from 'TB' col F - which we cannot see
  • lastrowf is determined from 'Factures' col F - which we cannot see
  • Sheets("TB").Cells(i, 2).Copy This is copying from col B of 'TB" - which we cannot see
  • Sheets("TB").Cells(i, 3).Copy This is copying from col C of 'TB" - which we cannot see
  • Sheets("TB").Cells(i, 4).CopyThis is copying from col D of 'TB" - which we cannot see
  • Sheets("TB").Range("G" & i & ":U" & i).Copy We cannot see any of these columns
  • Sheets("Factures").Range("E25:E46").SpecialCells(xlCellTypeVisible).Copy We cannot see rows 25:46 on 'Factures'
  • Sheets("Factures").Range("O25:O46").SpecialCells(xlCellTypeVisible).Copy Again, we cannot see this range

Finally, please confirm exactly which line caused the error
 
Upvote 0
Peter_SSs said:
It is not possible for us to reasonably test your code to investigate since it refers to many cells/ranges/columns that are not shown in your XL2BB samples. For example
  • lastrow is determined from 'TB' col F - which we cannot see
  • lastrowf is determined from 'Factures' col F - which we cannot see
  • Sheets("TB").Cells(i, 2).Copy This is copying from col B of 'TB" - which we cannot see
  • Sheets("TB").Cells(i, 3).Copy This is copying from col C of 'TB" - which we cannot see
  • Sheets("TB").Cells(i, 4).CopyThis is copying from col D of 'TB" - which we cannot see
  • Sheets("TB").Range("G" & i & ":U" & i).Copy We cannot see any of these columns
  • Sheets("Factures").Range("E25:E46").SpecialCells(xlCellTypeVisible).Copy We cannot see rows 25:46 on 'Factures'
  • Sheets("Factures").Range("O25:O46").SpecialCells(xlCellTypeVisible).Copy Again, we cannot see this range

Finally, please confirm exactly which line caused the error
Click to expand...
Sorry for the late reply
I found a solution on my own I created another sheet "Paste" to paste the filtred data then copy and paste it in the destination i want

VBA Code: 
Sub Enq()

Dim Ref As Range

Application.ScreenUpdating = False

lastrow = Sheets("TB").Cells(Rows.Count, "F").End(xlUp).Row
lastrowf = Sheets("Factures").Cells(Rows.Count, "F").End(xlUp).Row

    Dim rngSrc As Range
    Dim arrRef As Variant

Set rngSrc = Sheets("TB").Range("A5:A" & lastrow)
        arrRef = rngSrc.Value2

For i = 5 To lastrow

Sheets("Enq").Range("C20:I42,L20:Q42").ClearContents                                'Vider les cellules
Sheets("Enq").Range("C14:Q14").ClearContents
Sheets("Enq").Range("K16:Q16").ClearContents
Sheets("Enq").Range("D17:P17").ClearContents
Sheets("Enq").Range("F18:I18").ClearContents

Sheets("Paste").Range("A:B").ClearContents


    Sheets("TB").Cells(i, 2).Copy                                 'Nom
    Sheets("Enq").Range("K16").PasteSpecial Paste:=xlPasteValues
 
    Sheets("TB").Cells(i, 3).Copy                                 'Adresse
    Sheets("Enq").Range("D17").PasteSpecial Paste:=xlPasteValues
 
    Sheets("TB").Cells(i, 4).Copy                                 'Date Résil
    Sheets("Enq").Range("F18").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
    Sheets("TB").Range("G" & i & ":U" & i).Copy             'Ref                   'Ref
    Sheets("Enq").Range("C14").PasteSpecial Paste:=xlPasteValues
   
   
    Sheets("Enq").Cells(1, 1).Value = arrRef(i - 4, 1)  'replir lq cellule A1 pour le nom de PDF
 
     'Filter rows based on Ref
    Sheets("Factures").Range("A1:AI" & lastrowf).AutoFilter
    Sheets("Factures").Range("A1:AI" & lastrowf).AutoFilter Field:=18, Criteria1:=arrRef(i - 4, 1)
 
    'Copy filtered table and paste it in Destination cells.
   
    lastrowf2 = Sheets("Factures").Cells(Rows.Count, "F").End(xlUp).Row
   
   
    Sheets("Factures").Range("E2:E" & lastrowf2).SpecialCells(xlCellTypeVisible).Copy       'Copier les dates
   
    Sheets("Paste").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
     
    Sheets("Factures").Range("O2:O" & lastrowf2).SpecialCells(xlCellTypeVisible).Copy       'Copier les montant
   
    Sheets("Paste").Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
 
   
   
   
   
    Sheets("Paste").Range("A1:A23").SpecialCells(xlCellTypeVisible).Copy                    'Coller les dates vers le tbl droite
   
    Sheets("Enq").Range("C20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  
   
    Sheets("Paste").Range("B1:B23").SpecialCells(xlCellTypeVisible).Copy                    'Coller les montants vers le tbl droite
   
    Sheets("Enq").Range("G20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
   
   
   
   
    Sheets("Paste").Range("A24:A46").SpecialCells(xlCellTypeVisible).Copy                   'Coller les dates vers le tbl gauche
   
    Sheets("Enq").Range("L20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  
   
    Sheets("Paste").Range("B24:B46").SpecialCells(xlCellTypeVisible).Copy                   'Coller les montants vers le tbl gauche
   
    Sheets("Enq").Range("O20").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
   
   
   
   
Sheets("Enq").Cells(1, 1).NumberFormat = "@"                'Format texte de cellele A1



    Application.CutCopyMode = False

'________________PDF


Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant

Set wbA = ActiveWorkbook
Set wsA = Sheets("Enq")
'
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If

strPath = strPath & "\"

strName = wsA.Range("A1").Value _

'create default name for savng file
strFile = strName & ".pdf"
strPathFile = strPath & strFile

   'export to PDF in current folder
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
     

    Next i


Sheets("Factures").AutoFilterMode = False


Application.ScreenUpdating = True



End Sub

Thank you very much Mr.Peter
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

youbitto
  • Question Question
Searching For a value in a range and write a texte if the value is found
Replies
0
Views
38
youbitto
youbitto
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
198
NdNoviceHlp
NdNoviceHlp
A
  • Question Question
VBA Copy/Paste New Data Only
Replies
0
Views
434
ah2024_2024
A
R
  • Question Question
Compose Email VBA Help
Replies
1
Views
58
Logit
Logit
I
  • Question Question
Filter column on text value if that value exists using VBA
Replies
7
Views
296
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,981
Messages
6,175,773
Members
452,668
Latest member
mrider123

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top