Copy non-empty cells from the same column from multiple sheets to a sheet "Breeders"

H

harzer

Board Regular
Joined
Dec 15, 2021
Messages
157
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone,
I want to copy all cells with data from column "D" of the following sheets: "Classe A", "Classe B", "Classe C", "Classe D", "Classe E", "Classe F", "Classe AK", "Classe BK", "Classe CK", "Classe A4T", "Classe B4T", "Classe C4T", "Classe AK4T", "Classe BK4T", "Classe CK4T" to sheet: "Breeders", in column: "B" from cell "B2"
Two pieces of information to point out to you:
1- We do not keep empty cells in column "D" and we do not take into account hidden cells (not visible) in column "D".
2- When all the non-empty cells in columns "D" of all the sheets mentioned above are copied into column "B" of the "Breeders" sheet, you must remove the duplicates from this list and sort it in ascending order.
I remain at your disposal if you need additional information.
Thank you in advance for your contributions.

Here are 3 examples of types of sheets used:

Sheet "Classe A" :


Sheet "Classe B" :


Sheet "Classe C" :


Here is the type of result desired :
List of Breeders.xls
AB
1List Breeders
21-Bailly René
32-Ballant Gérard
43-Classe A
54-Classe A4T
65-Classe AK
76-Classe AK4T
87-Classe B
98-Classe B4T
109-Classe BK
1110-Classe BK4T
1211-Classe C
1312-Classe C4T
1413-Classe CK
1514-Classe CK4T
1615-Classe D
1716-Classe E
1817-Classe F
1918-Cobart Kévin
2019-Colin Edouard
2120-Cornu Vincent
2221-Dupont Pierre
2322-ELBACHR Tahar
2423-Fatah brahim
2524-Hautem Maurice
2625-Ladavid Catherine
2726-Ladrière Vincent
2827-Legrand Maurice
2928-Lermithe Roland
3029-Leroy Albert
3130-Magdan Roland
3231-Mariètte Audile
3332-MARTIN Marie
3433-Petit Valérie
3534-Roland Bernard
3635-Roland Maurice
3736-Salvsadoré Théodore
3837-vandehatine Emeric
Breeders
 
Last edited:

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Here are 3 examples of types of sheets used:

Sheet "Classe A" :
List of Breeders.xls
ABCDEFGHIJKLMNOPQ
1NumCageBreedersMathlknwatholflschklkklinrolimpnégtotal
2chLegrand Maurice22242415-481
31Ladrière Vincent212224-265
42Cobart Kévin202224-660
53Lermithe Roland241624-559
64Colin Edouard22152259
75Mariètte Audile211233
86Ladavid Catherine2121
97Salvsadoré Théodore21-417
108Roland Maurice21-717
119Classe A0
12100
13110
14120
15130
Classe A
Cells with Data Validation
CellAllowCriteria
D2:D15List=SI(D2<>"";DECALER(Liste;EQUIV(D2&"*";Liste;0)-1;;NB.SI(Liste;D2&"*");1);Liste)


Sheet "Classe B" :
List of Breeders.xls
ABCDEFGHIJKLMNOPQR
1NumCageBreedersMathlknwatholflschklkklinrolimpnégTotalTOTAL
2PHRoland Bernard99-594
3-1-193
51Bailly René9292
6092
82Fatah brahim9090
9090
113vandehatine Emeric8585
12085
144Hautem Maurice1010
15010
175Classe B0
1800
2060
2100
2370
2400
2680
2700
2990
3000
Classe B
Cells with Data Validation
CellAllowCriteria
D5List=SI(D5<>"";DECALER(Liste;EQUIV(D5&"*";Liste;0)-1;;NB.SI(Liste;D5&"*");1);Liste)
D8List=SI(D8<>"";DECALER(Liste;EQUIV(D8&"*";Liste;0)-1;;NB.SI(Liste;D8&"*");1);Liste)
D11List=SI(D11<>"";DECALER(Liste;EQUIV(D11&"*";Liste;0)-1;;NB.SI(Liste;D11&"*");1);Liste)
D14List=SI(D14<>"";DECALER(Liste;EQUIV(D14&"*";Liste;0)-1;;NB.SI(Liste;D14&"*");1);Liste)
D17List=SI(D17<>"";DECALER(Liste;EQUIV(D17&"*";Liste;0)-1;;NB.SI(Liste;D17&"*");1);Liste)
D20List=SI(D20<>"";DECALER(Liste;EQUIV(D20&"*";Liste;0)-1;;NB.SI(Liste;D20&"*");1);Liste)
D23List=SI(D23<>"";DECALER(Liste;EQUIV(D23&"*";Liste;0)-1;;NB.SI(Liste;D23&"*");1);Liste)
D26List=SI(D26<>"";DECALER(Liste;EQUIV(D26&"*";Liste;0)-1;;NB.SI(Liste;D26&"*");1);Liste)
D29List=SI(D29<>"";DECALER(Liste;EQUIV(D29&"*";Liste;0)-1;;NB.SI(Liste;D29&"*");1);Liste)
D2List=SI(D2<>"";DECALER(Liste;EQUIV(D2&"*";Liste;0)-1;;NB.SI(Liste;D2&"*");1);Liste)
Q2Whole number<>100
Q5Whole number<>100
Q8Whole number<>100
Q11Whole number<>100
Q14Whole number<>100
Q17Whole number<>100
Q20Whole number<>100
Q23Whole number<>100
Q26Whole number<>100
Q29Whole number<>100
Q1Any value
R1Any value


Sheet "Classe C" :
List of Breeders.xls
ABCDEFGHIJKLMNOPQRS
1NumCageBreedersMathlknwatholflschklkklinrolimpnégTotalHarTOTAL
2PHBallant Gérard2222
32222
422
52288
71Petit Valérie2121
82121
90
10042
122Cornu Vincent2020
132020
140
15040
173Dupont Pierre1919
181919
190
20038
224Leroy Albert1818
231818
240
25036
275Hautem Maurice1414
281414
290
30028
326Classe C0
330
340
3500
3770
380
390
4000
Classe C
Cells with Data Validation
CellAllowCriteria
D2List=SI(D2<>"";DECALER(Liste;EQUIV(D2&"*";Liste;0)-1;;NB.SI(Liste;D2&"*");1);Liste)
D7List=SI(D7<>"";DECALER(Liste;EQUIV(D7&"*";Liste;0)-1;;NB.SI(Liste;D7&"*");1);Liste)
D17List=SI(D17<>"";DECALER(Liste;EQUIV(D17&"*";Liste;0)-1;;NB.SI(Liste;D17&"*");1);Liste)
D22List=SI(D22<>"";DECALER(Liste;EQUIV(D22&"*";Liste;0)-1;;NB.SI(Liste;D22&"*");1);Liste)
D27List=SI(D27<>"";DECALER(Liste;EQUIV(D27&"*";Liste;0)-1;;NB.SI(Liste;D27&"*");1);Liste)
D32List=SI(D32<>"";DECALER(Liste;EQUIV(D32&"*";Liste;0)-1;;NB.SI(Liste;D32&"*");1);Liste)
D37List=SI(D37<>"";DECALER(Liste;EQUIV(D37&"*";Liste;0)-1;;NB.SI(Liste;D37&"*");1);Liste)
D12List=SI(D12<>"";DECALER(Liste;EQUIV(D12&"*";Liste;0)-1;;NB.SI(Liste;D12&"*");1);Liste)
S1Any value
Q1Any value
 
Upvote 0
Try:
VBA Code: 
Sub CopyNonEmptyCells()
    Application.ScreenUpdating = False
    Dim srcRng As Range, rng As Range, ws As Worksheet, lRow As Long, dic As Object, desWS As Worksheet
    Set desWS = Sheets("Breeders")
    Set dic = CreateObject("Scripting.Dictionary")
    For Each ws In Sheets(Array("Classe A", "Classe B", "Classe C", "Classe D", "Classe E", "Classe F", "Classe AK", "Classe BK", _
        "Classe CK", "Classe A4T", "Classe B4T", "Classe C4T", "Classe AK4T", "Classe BK4T", "Classe CK4T"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set srcRng = .Range("D2:D" & lRow).SpecialCells(xlVisible)
            For Each rng In srcRng
                If rng <> "" Then
                    If Not dic.exists(rng) Then
                        dic.Add rng, Nothing
                    End If
                End If
            Next rng
        End With
    Next ws
    With desWS
        .Range("B2").Resize(dic.Count) = Application.Transpose(dic.keys)
        .Cells(1, 1).Sort Key1:=.Columns(2), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
        .Range("A2") = "1"
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        .Range("A2").AutoFill Destination:=.Range("A2:A" & lRow), Type:=xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hello mumps,
Thanks for your feedback and the proposed code, the latter works very well and very fast, however, it lacks a very small detail for it to be complete, namely, that in the list of the sheet "Breeders" in column "B", we must not have duplicates, therefore only unique elements.
Thanks in advance.
 
Upvote 0
Try:
VBA Code: 
Sub CopyNonEmptyCells()
    Application.ScreenUpdating = False
    Dim srcRng As Range, rng As Range, ws As Worksheet, lRow As Long, dic As Object, desWS As Worksheet
    Set desWS = Sheets("Breeders")
    Set dic = CreateObject("Scripting.Dictionary")
    For Each ws In Sheets(Array("Classe A", "Classe B", "Classe C", "Classe D", "Classe E", "Classe F", "Classe AK", "Classe BK", _
        "Classe CK", "Classe A4T", "Classe B4T", "Classe C4T", "Classe AK4T", "Classe BK4T", "Classe CK4T"))
        With ws
            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set srcRng = .Range("D2:D" & lRow).SpecialCells(xlVisible)
            For Each rng In srcRng
                If rng <> "" Then
                    If Not dic.exists(rng.Value) Then
                        dic.Add rng.Value, Nothing
                    End If
                End If
            Next rng
        End With
    Next ws
    With desWS
        .Range("B2").Resize(dic.Count) = Application.Transpose(dic.keys)
        .Cells(1, 1).Sort Key1:=.Columns(2), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
        .Range("A2") = "1"
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        .Range("A2").AutoFill Destination:=.Range("A2:A" & lRow), Type:=xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Hello mumps
Thank you for your feedback and the requested update.
I can tell you that the update satisfies me and gives me the desired result.
Thank you mumps for your availability and sharing your knowledge.
Greetings.
 
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Question Question
VBA to copy each row from multiple sheets to single sheet
Replies
6
Views
341
MickG
M
D
  • Question Question
VBA Copy/Paste formula from D1 into empty cells in column D, starting at D6 and going down to last row
Replies
1
Views
1K
Fluff
Fluff
smide
  • Question Question
VBA - paste only non empty cells from multiple sheets in the next empty row on a different/master sheet
Replies
3
Views
764
Akuini
Akuini
smide
  • Question Question
VBA to fill empty cells with last non-empty text cell before 'emptiness' in column
Replies
1
Views
388
JackDanIce
JackDanIce
X
  • Question Question
Excel Macro to copy data in cell to multiple cells in the same row
Replies
3
Views
1K
hiker95
H

Forum statistics

Threads
1,224,587
Messages
6,179,734
Members
452,939
Latest member
WCrawford

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