Copy data within a specific table

sofas · Feb 11, 2023

Hello, how can I copy the filtered data inside a specific table instead of copying it in a regular range, for example tableau11

VBA Code:

Set SH1 = ThisWorkbook.Sheets("Recherche_ par date")
Set sh = ThisWorkbook.Sheets("Touts le valeurs ")
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A8:ae" & lastrow).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=SH1.Range("AG1:AH2"), _
CopyToRange:=SH1.Range("A9:ae9"), _
Unique:=True

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

VBA Code:

    Sheets("Touts le valeurs ").Range("Names[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("'Recherche_ par date'!Criteria"), _
        CopyToRange:=Range("A9:AE9"), Unique:=False

DanteAmor · Feb 11, 2023

If the data is already filtered you can copy the data in this way and paste it, for example, in Sheet3

VBA Code:

Sub CopyFilterTable()
  Dim sh As Worksheet
  Dim tbl As ListObject
 
  Set sh = Sheets("Touts le valeurs ")
  Set tbl = sh.ListObjects("tableau11")
  tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("B2")
End Sub

If you also want to copy the header use like this:

Rich (BB code):

tbl.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Hoja3").Range("B2")

----- --
But I see that you ask "how can I copy the filtered data inside a specific table" but your code has an advanced filter, in that case:
The data in "Touts le valeurs " sheet
The criteria in "Recherche_ par date" sheet
And the results in "Sheet3" (for example)

VBA Code:

Sub CopyFilterTable_()
  Dim sh As Worksheet
  Dim tbl As ListObject
 
  Set sh = Sheets("Touts le valeurs ")
  Set tbl = sh.ListObjects("tableau11")

  tbl.Range.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("'Recherche_ par date'!Criteria"), _
    CopyToRange:=Sheets("Sheet3").Range("A9"), Unique:=False
End Sub

sofas · Feb 11, 2023

DanteAmor said:
If the data is already filtered you can copy the data in this way and paste it, for example, in Sheet3

VBA Code:

Sub CopyFilterTable() Dim sh As Worksheet Dim tbl As ListObject Set sh = Sheets("Touts le valeurs ") Set tbl = sh.ListObjects("tableau11") tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Sheet3").Range("B2") End Sub

If you also want to copy the header use like this:

Rich (BB code):

tbl.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("Hoja3").Range("B2")

----- --
But I see that you ask "how can I copy the filtered data inside a specific table" but your code has an advanced filter, in that case:
The data in "Touts le valeurs " sheet
The criteria in "Recherche_ par date" sheet
And the results in "Sheet3" (for example)

VBA Code:

Sub CopyFilterTable_() Dim sh As Worksheet Dim tbl As ListObject Set sh = Sheets("Touts le valeurs ") Set tbl = sh.ListObjects("tableau11") tbl.Range.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("'Recherche_ par date'!Criteria"), _ CopyToRange:=Sheets("Sheet3").Range("A9"), Unique:=False End Sub

I mean, I want to copy the data from table1 after filtering it to table11

Alex Blakenburg · Feb 12, 2023

On a copy of your workbook see if this does what you want. It copies from the Table Names to the Table tableau11

VBA Code:

Sub TestCopyTableToTable()

    Dim SH1 As Worksheet, sh As Worksheet
    Dim tblNames As ListObject, tbl11 As ListObject
    Dim tbl11NewRow As ListRow

    Set SH1 = ThisWorkbook.Sheets("Recherche_ par date")
    Set sh = ThisWorkbook.Sheets("Touts le valeurs")

    Set tblNames = Range("Names").ListObject
    Set tbl11 = Range("tableau11").ListObject
    
    Dim lastDataCell_11 As Range
    Dim lastCell_11 As Range
    Set lastDataCell_11 = tbl11.ListColumns(1).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    Set lastCell_11 = tbl11.ListRows(tbl11.DataBodyRange.Rows.Count).Range(1)
    
    If tbl11.DataBodyRange Is Nothing Then
        Set tbl11NewRow = tbl11.ListRows.Add
    ElseIf lastDataCell_11.Row = lastCell_11.Row Then
        Set tbl11NewRow = tbl11.ListRows.Add
    Else
        Set tbl11NewRow = tbl11.ListRows(tbl11.DataBodyRange.Rows.Count)
    End If
     
    Range("Names[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=Range("Criteria"), _
        CopyToRange:=tbl11NewRow.Range.Cells(1), Unique:=False
        
    Dim tbl11_NewLastRow As Range
    Dim tbl11_AddRows As Long
    Set tbl11_NewLastRow = SH1.Cells(Rows.Count, tbl11.Range.Column).End(xlUp)
    Set lastCell_11 = tbl11.ListRows(tbl11.DataBodyRange.Rows.Count).Range(1)
    tbl11_AddRows = tbl11_NewLastRow.Row - lastCell_11.Row
        
    Dim Rng As Range
    Set Rng = Range(tbl11.Name & "[#All]").Resize(tbl11.Range.Rows.Count + tbl11_AddRows, tbl11.Range.Columns.Count)
  
    tbl11.Resize Rng
        
    tbl11NewRow.Range.Delete
   
End Sub

sofas · Feb 12, 2023

Hello. Thank you for your interest . For the first time, the code worked and copied all the data without filtering between the selected dates. When I try again, I get an error message. The purpose of this is to filter the data and copy it into a table with the size of the number of filtered rows. When trying again, the previous results are deleted and the new ones are copied in the same way. No blank rows in the table

easyupload.io

Alex Blakenburg · Feb 12, 2023

Had we had visibility of the your criteria range initially we probably would have suggested autofilter rather than advanced filter.

In your sample file, Names is just a range name and "not" a table name.
Also your Criteria Range is using Headings that don't appear in the Table and as such don't work in an Advanced filter.

I have the code I have below relies on the following changed.
1) Delete your "Names" Named range and change the Table into a real excel table and call it "Names"
(its possible this all happened when you created the sample file)
2) In the sheet "Recherche_ par date" add the rows I have added with formulas and call those additional 4 cells "Criteria" with scope of Sheet.
You can then hide the rows, they are only being used by the Advanced filter.

20230212 VBA Copy From Table to Table sofas v02.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

1

star Date

Fin Date

2

4/02/2023

5/02/2023

3

4

Range Name > Criteria >

Date

5

>=44961

<=44962

6

7

8

9

Date

Semaine

Taille

Machine

Poids

Apsorbtion

Rétention

Poids

Rewet1

Rewet2

Rewet3

Diffusion

Poids

AQR1

AQR2

AQR3

RUL1

RUL2

RUL3

Diffusion

Column1

Column2

Column3

Column4

Column5

Column6

Column7

Column8

Column9

Column10

Column11

10

Recherche_ par date

Cell Formulas
Range	Formula
F5	F5	=">=" &F2
G5	G5	="<=" &G2

Then try this code:

VBA Code:

Sub TestCopyTableToTable_v02_ZeroTable()

    Dim SH1 As Worksheet, sh As Worksheet
    Dim tblNames As ListObject, tbl11 As ListObject
    Dim tbl11NewRow As ListRow

    Set SH1 = ThisWorkbook.Sheets("Recherche_ par date")
    Set sh = ThisWorkbook.Sheets("Touts le valeurs")

    Set tblNames = Range("Names").ListObject
    Set tbl11 = Range("tableau11").ListObject
  
    If Not tbl11.DataBodyRange Is Nothing Then
        tbl11.DataBodyRange.Delete
    End If
  
    Set tbl11NewRow = tbl11.ListRows.Add
   
    Range("Names[#All]").AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=SH1.Range("Criteria"), _
        CopyToRange:=tbl11NewRow.Range.Cells(1), Unique:=False
      
    Dim tbl11_NewLastRow As Range
    Dim tbl11_AddRows As Long
    Dim lastCell_11 As Range
    Set tbl11_NewLastRow = SH1.Cells(Rows.Count, tbl11.Range.Column).End(xlUp)
    Set lastCell_11 = tbl11.ListRows(tbl11.DataBodyRange.Rows.Count).Range(1)
    tbl11_AddRows = tbl11_NewLastRow.Row - lastCell_11.Row
      
    Dim Rng As Range
    Set Rng = Range(tbl11.Name & "[#All]").Resize(tbl11.Range.Rows.Count + tbl11_AddRows, tbl11.Range.Columns.Count)
    tbl11.Resize Rng
      
    tbl11NewRow.Range.Delete        ' Delete the heading row brought in by the Advanced Filter
 
End Sub

sofas · Feb 12, 2023

Alex Blakenburg said:
Had we had visibility of the your criteria range initially we probably would have suggested autofilter rather than advanced filter.

In your sample file, Names is just a range name and "not" a table name.
Also your Criteria Range is using Headings that don't appear in the Table and as such don't work in an Advanced filter.

I have the code I have below relies on the following changed.
1) Delete your "Names" Named range and change the Table into a real excel table and call it "Names"
(its possible this all happened when you created the sample file)
2) In the sheet "Recherche_ par date" add the rows I have added with formulas and call those additional 4 cells "Criteria" with scope of Sheet.
You can then hide the rows, they are only being used by the Advanced filter.

20230212 VBA Copy From Table to Table sofas v02.xlsm
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE
1 star Date Fin Date
2 4/02/2023 5/02/2023
3
4 Range Name > Criteria > Date Date
5 >=44961 <=44962
6
7
8
9 Date Semaine Taille Machine Poids Apsorbtion Rétention Poids Rewet1 Rewet2 Rewet3 Diffusion Poids AQR1 AQR2 AQR3 RUL1 RUL2 RUL3 Diffusion Column1 Column2 Column3 Column4 Column5 Column6 Column7 Column8 Column9 Column10 Column11
10
Recherche_ par date
Cell Formulas
Range Formula
F5 F5 =">=" &F2
G5 G5 ="<=" &G2

Then try this code:

VBA Code:

Sub TestCopyTableToTable_v02_ZeroTable() Dim SH1 As Worksheet, sh As Worksheet Dim tblNames As ListObject, tbl11 As ListObject Dim tbl11NewRow As ListRow Set SH1 = ThisWorkbook.Sheets("Recherche_ par date") Set sh = ThisWorkbook.Sheets("Touts le valeurs") Set tblNames = Range("Names").ListObject Set tbl11 = Range("tableau11").ListObject If Not tbl11.DataBodyRange Is Nothing Then tbl11.DataBodyRange.Delete End If Set tbl11NewRow = tbl11.ListRows.Add Range("Names[#All]").AdvancedFilter Action:= _ xlFilterCopy, CriteriaRange:=SH1.Range("Criteria"), _ CopyToRange:=tbl11NewRow.Range.Cells(1), Unique:=False Dim tbl11_NewLastRow As Range Dim tbl11_AddRows As Long Dim lastCell_11 As Range Set tbl11_NewLastRow = SH1.Cells(Rows.Count, tbl11.Range.Column).End(xlUp) Set lastCell_11 = tbl11.ListRows(tbl11.DataBodyRange.Rows.Count).Range(1) tbl11_AddRows = tbl11_NewLastRow.Row - lastCell_11.Row Dim Rng As Range Set Rng = Range(tbl11.Name & "[#All]").Resize(tbl11.Range.Rows.Count + tbl11_AddRows, tbl11.Range.Columns.Count) tbl11.Resize Rng tbl11NewRow.Range.Delete ' Delete the heading row brought in by the Advanced Filter End Sub

Thank you. This was done when copying and pasting to create the sample. Now everything works very well.

Alex Blakenburg · Feb 12, 2023

Thanks for letting us know. Glad we could help.

Copy data within a specific table

sofas

Well-known Member

Excel Facts

DanteAmor

Well-known Member

sofas

Well-known Member

Alex Blakenburg

MrExcel MVP

sofas

Well-known Member

easyupload.io

Attachments

Alex Blakenburg

MrExcel MVP

sofas

Well-known Member

Alex Blakenburg

MrExcel MVP

Similar threads

Forum statistics

Share this page

Copy data within a specific table

Well-known Member

Excel Facts

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

Attachments

MrExcel MVP

Well-known Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock