Autofill a dynamic Table 2 with a dynamic Table 1? (Criteria-based)

Y

YourBroLucas

New Member
Joined
Jul 11, 2022
Messages
29
Office Version
  1. 2016
Platform
  1. Windows
Howdy dear Excel specialists,

This is my first time on any Excel forums. I've tried to look at other threads before posting this one, yet I don't seem to be able to apply it to my own situation, nor can I understand a thing of that VBA witchcraft.

So I have this main table that regroups all transactions made by any department, put in chronological order.

I would now like to autofill per-department tables in other sheets, with transactions having the sole criteria of belonging to a specific department.
Yet I wish to copy the entire row of 15 columns.

As nobody knows the amount of transactions throughout the year, the tables have to be dynamic.
As such, and considering how little I know about VBA, it comes to my understanding that I can't rely on functions alone and that there shall be a certain portion of macro learning.

I know similar threads exist out there, but I struggle to find a discussion that deals with dynamic databases.

Since there are some crafty excel enthusiasts out here, I wondered if you had some of those tips most mortals can't even dream of possessing.

With my undying gratitude,
Love from France ♥,
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
More details are required to help you.

YourBroLucas said:
So I have this main table that regroups all transactions made by any department, put in chronological order.
Click to expand...
What is the name of the column heading of the 'department' column in the main table? The main table can be autofiltered using this column by each specific department.

YourBroLucas said:
I would now like to autofill per-department tables in other sheets, with transactions having the sole criteria of belonging to a specific department.
Click to expand...
Do you really mean 'autofill', as in filling down and generating rows automatically? Or do you mean 'copy' rows from the main table to each specific department table?

What are the names of the other sheets containing the department tables? Are the sheet names related to the department names? E.g. department "AA" is on the sheet named "AA".

What are the names of the department tables? If they don't have specific names what are the index numbers of the tables on each sheet? E.g. each department table is the 1st table on each sheet.
 
Upvote 0
Hi,

Thank you for your concern!

I understand that my message was quite unclear, so after a bit of learning I wrote my very first excel macro!

One may think this macro humble, but I'm proud and happy it kinda work.

VBA Code: 
Sub ExportFilteredData()

' I. DICOM. Variables
Dim shGen As Worksheet
Dim shDicom As Worksheet
Dim DirDICOM As String

Set shGen = Sheets("Tab_Général")
Set shDicom = Sheets("Auto_DICOM")
DirDICOM = "DICOM"

' I. DICOM. Dynamic range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set StartCell = Range("A16")

' I. DICOM. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' I. DICOM. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDICOM

' I. DICOM. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDicom.Range("A16").PasteSpecial Paste:=xlPasteAll

' I. DICOM. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData

' I. DICOM. Reinitialise the shGen filters (chrono order)
    ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
'
'

' II. DAP. Variables
Dim shDAP As Worksheet
Dim DirDAP As String

Set shDAP = Sheets("Auto_DAP")
DirDAP = "DAP"

' II. DAP. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' II. DAP. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDAP

' II. DAP. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDAP.Range("A16").PasteSpecial Paste:=xlPasteAll

' II. DAP. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData

' II. DAP. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

End With
'
'

' III. DSJ. Variables
Dim shDSJ As Worksheet
Dim DirDSJ As String

Set shDSJ = Sheets("Auto_DSJ")
DirDSJ = "DSJ"

' III. DSJ. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' III. DSJ. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDSJ

' III. DAP. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDSJ.Range("A16").PasteSpecial Paste:=xlPasteAll

' III. DSJ. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData

' III. DSJ. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

End With
'
'

' IV. DPJJ. Variables
Dim shDPJJ As Worksheet
Dim DirDPJJ As String

Set shDPJJ = Sheets("Auto_DPJJ")
DirDPJJ = "DPJJ"

' IV. DPJJ. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' IV. DPJJ. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDPJJ

' IV. DPJJ. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDPJJ.Range("A16").PasteSpecial Paste:=xlPasteAll

' IV. DPJJ. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData

' IV. DPJJ. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

End With
'
'

' V. PVAM. Variables
Dim shPVAM As Worksheet
Dim DirPVAM As String

Set shPVAM = Sheets("Auto_PVAM")
DirPVAM = "PVAM"

' V. PVAM. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

' V. PVAM. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirPVAM

' V. PVAM. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shPVAM.Range("A16").PasteSpecial Paste:=xlPasteAll

' V. PVAM. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData

' V. PVAM. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
        SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

End With

End Sub
 
Last edited by a moderator:
Upvote 0
John_w said:
More details are required to help you.


What is the name of the column heading of the 'department' column in the main table? The main table can be autofiltered using this column by each specific department.


Do you really mean 'autofill', as in filling down and generating rows automatically? Or do you mean 'copy' rows from the main table to each specific department table?

What are the names of the other sheets containing the department tables? Are the sheet names related to the department names? E.g. department "AA" is on the sheet named "AA".

What are the names of the department tables? If they don't have specific names what are the index numbers of the tables on each sheet? E.g. each department table is the 1st table on each sheet.
Click to expand...
Alright I messed up the VBA wrap up.
On a sidenote, I know there are probably tons of ways this could have been simpler and prettier, but I did what I could.
(If + Loop maybe?)

VBA Code: 
Sub ExportFilteredData()
' I. DICOM. Variables
Dim shGen As Worksheet
Dim shDicom As Worksheet
Dim DirDICOM As String
Set shGen = Sheets("Tab_Général")
Set shDicom = Sheets("Auto_DICOM")
DirDICOM = "DICOM"
' I. DICOM. Dynamic range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set StartCell = Range("A16")
' I. DICOM. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' I. DICOM. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDICOM
' I. DICOM. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDicom.Range("A16").PasteSpecial Paste:=xlPasteAll
' I. DICOM. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' I. DICOM. Reinitialise the shGen filters (chrono order)
   ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Clear
   ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
       xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
End With
'
'
' II. DAP. Variables
Dim shDAP As Worksheet
Dim DirDAP As String
Set shDAP = Sheets("Auto_DAP")
DirDAP = "DAP"
' II. DAP. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' II. DAP. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDAP
' II. DAP. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDAP.Range("A16").PasteSpecial Paste:=xlPasteAll
' II. DAP. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' II. DAP. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Clear
   ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
       xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
End With
'
'
' III. DSJ. Variables
Dim shDSJ As Worksheet
Dim DirDSJ As String
Set shDSJ = Sheets("Auto_DSJ")
DirDSJ = "DSJ"
' III. DSJ. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' III. DSJ. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDSJ
' III. DAP. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDSJ.Range("A16").PasteSpecial Paste:=xlPasteAll
' III. DSJ. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' III. DSJ. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Clear
   ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
       xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
End With
'
'
' IV. DPJJ. Variables
Dim shDPJJ As Worksheet
Dim DirDPJJ As String
Set shDPJJ = Sheets("Auto_DPJJ")
DirDPJJ = "DPJJ"
' IV. DPJJ. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' IV. DPJJ. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDPJJ
' IV. DPJJ. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDPJJ.Range("A16").PasteSpecial Paste:=xlPasteAll
' IV. DPJJ. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' IV. DPJJ. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Clear
   ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
       xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
End With
'
'
' V. PVAM. Variables
Dim shPVAM As Worksheet
Dim DirPVAM As String
Set shPVAM = Sheets("Auto_PVAM")
DirPVAM = "PVAM"
' V. PVAM. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' V. PVAM. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirPVAM
' V. PVAM. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shPVAM.Range("A16").PasteSpecial Paste:=xlPasteAll
' V. PVAM. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' V. PVAM. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Clear
   ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
       SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
       xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
End With
End Sub
 
Last edited by a moderator:
Upvote 0
YourBroLucas said:
(How the hell do you put the code in quick-wrap as VBA code??)
Click to expand...
Insert code between vba code tags, you left the vba code tags on the end of your post, thats why it is empty.
VBA Code: 
sub yourbrolucas ()
hallo
end sub
 
Upvote 0
Alright thank you everyone, although I'd be delighted to know how I could improve the effectiveness/simplicity of this macro, I think I will keep it for another thread and issue.

Until next time,
 
Upvote 0
YourBroLucas said:
Alright thank you everyone, although I'd be delighted to know how I could improve the effectiveness/simplicity of this macro, I think I will keep it for another thread and issue.

Until next time,
Click to expand...
See if this gives you any ideas:

VBA Code: 
Sub ExportFilteredData()

    Dim shGen As Worksheet
    Dim arrCategories As Variant, sCat As Variant, shtCat As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim StartCell As Range
   
    arrCategories = Array("DICOM", "DAP", "DSJ", "DPJJ", "PVAM")
   
    Set shGen = ActiveWorkbook.Worksheets("Tab_Général")
    LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set StartCell = shGen.Range("A16")
    shGen.Range("A16:P" & LastRow).AutoFilter
   
    shGen.ListObjects("Tableau12").Sort. _
        SortFields.Clear
    shGen.ListObjects("Tableau12").Sort. _
        SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With shGen.ListObjects("Tableau12").Sort
           .Header = xlYes
           .MatchCase = False
           .Orientation = xlTopToBottom
           .SortMethod = xlPinYin
           .Apply
    End With
    '
    For Each sCat In arrCategories
        Set shtCat = Worksheets("Auto_" & sCat)
        shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=sCat
        shGen.Range("A16:P" & LastRow).Copy
        shtCat.Range("A16").PasteSpecial Paste:=xlPasteAll
    Next sCat
   
    Application.CutCopyMode = False
    shGen.ShowAllData
    shGen.AutoFilterMode = False
     
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

Y
  • Solved
Copy/paste dynamic, filtered data + put a column into next row (through macro)
Replies
2
Views
1K
YourBroLucas
Y
B
  • Question Question
Macro to remove duplicate values based upon 2 criteria
2
Replies
12
Views
1K
DanteAmor
DanteAmor
P
  • Question Question
Narrowing a table based on criteria
Replies
1
Views
671
Eric W
Eric W
K
  • Question Question
help autofill function to last row between 2 columns in a dynamic table
Replies
2
Views
449
kmillanr
K
B
  • Question Question
Fun Index array formula based on multiple criteria
Replies
6
Views
1K
Eric W
Eric W

Forum statistics

Threads
1,226,740
Messages
6,192,742
Members
453,755
Latest member
IQBS

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