Take listed items from 3 worksheets, paste them all into a master worksheet macro

[cleareyes]

Hello,
I'm brand new to this forum so the usual apologies if this is not appropriate place or specific subject.

I'm working on a project in excel that essentially loops through worksheets, which each have a simple list of items, and copies those items all onto a master list.
I'm new to VBA scripting and I cannot determine the best path to use. I am trying now to use a nested for each loop to go through the individual worksheets, and within that a do while loop to copy the data from the lists to paste onto the master list (a separate worksheet).

Here is my macro as it stands now (not at all complete), would someone be able to point me in the right direction?

Sub Macro1()
    Dim ws As Worksheet
    Dim i As Integer
    For Each ws In ActiveWorkbook.Worksheets
         i = 12 '**i=12 as the list on every worksheet starts at D12**'
         
         Do While (currentWorksheet.Cells(i, 4) <> "")
         Range("D12").Select
         Selection.Copy
         Sheets("Transaction List").Select '**Transaction List = Master List**'
          Range("F6").Select '**F6 is the first line of the master list**'
          ActiveSheet.Paste '**How can I stop the macro from just pasting over itself instead of properly creating a list?**'
         i = i + 1 '**I'm concerned because how will I be able to reset the counter on a new ws?**'
         Loop
         
        On Error Resume Next 
                  
    Next ws
End Sub

I realize this is probably low-level stuff to you all, but any help would be appreciated.

 

[dmt32]

Hi welcome to the board.

see if this does what you want

Dave

Sub Macro1()
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lr As Long
    Set wsMaster = Worksheets("Transaction List")
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> wsMaster.Name Then
            lr = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
            Set rng1 = ws.Range("D12:D" & lr)
            lr = wsMaster.Cells(wsMaster.Rows.Count, "F").End(xlUp).Row + 1
            If lr < 6 Then lr = 6
            Set rng2 = wsMaster.Range("F" & lr)
            rng1.Copy rng2
            
        End If
        Next ws
    End Sub

 

[cleareyes]

Dave, the code works wonderfully. I read it line by line and figured out how you approached the problem. I'm still doing some tweaking to add some more functionality to the macro, but for the most part this is great. I'll reply back in a few hours once I have gotten this up and running. BIG thank you to my pal across the pond, Dave.

 

[cleareyes]

One last question: I am also trying to copy single unlisted items that are on each worksheet (cells "E2" , "D7" and "D8" on each worksheet) and paste them in a range on the master list that corresponds with the items(from that ws) listed. The following pictures show an example of what I'm getting at:
A typical nonMaster WS

(Typical nonMaster worksheet - Imgur) and then the master WS

(How the master ws should look - Imgur)

I'm trying to code it (with your given code) as such:

Dim colors As Range
Dim pasteranges As Range

'***Within the For Each Loop and within the If Then***'

Set colors = ws.Range("E2")
Set pasteranges = wsMaster.Range("B" & lr)
colors.Copy pasteranges

However, this output only pastes once per worksheet in the master list. (B6 will say Blue, but B6:B9 should say Blue. B10 will say Green, but B10:B11 should say Green, etc)

 

[dmt32]

Hi,
pleased to hear that code I cobbled together very quickly for you worked ok.
I don't have great deal of time today but have made a vain attempt to adjust the code to take in account addition requirements - see if it does what you want. I have not had time to fully test but think it's going in the right direction.

I should add, that whilst the approach I have taken is ok when processing small amounts of data, code can become slow when dealing with larger amounts - in this case, it would be better to use arrays but that is for another time or perhaps another on this board will post such a solution for you.

I like the friend accross the pond - I have family in HHI SC.


Dave

Sub Macro1()
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lr As Long
    Dim unlisted()
    Dim CalcMode As String
    
    Set wsMaster = Worksheets("Transaction List")
    
    With Application
        .ScreenUpdating = False
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        
    End With
    
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> wsMaster.Name Then
            With ws
                unlisted = Array(.Range("E2"), .Range("D7"), .Range("D8"))

                lr = .Cells(.Rows.Count, "D").End(xlUp).Row
                Set rng1 = .Range("D12:D" & lr)
            End With
            lr = wsMaster.Cells(wsMaster.Rows.Count, "E").End(xlUp).Row + 1
            If lr < 6 Then lr = 6
            Set rng2 = wsMaster.Range("E" & lr)
            rng1.Copy rng2
            With wsMaster
                .Range(.Cells(lr, 2), .Cells(rng1.Count + lr - 1, 2)).Value = unlisted(0)
                .Range(.Cells(lr, 3), .Cells(rng1.Count + lr - 1, 3)).Value = unlisted(1)
                .Range(.Cells(lr, 4), .Cells(rng1.Count + lr - 1, 4)).Value = unlisted(2)

            End With
        End If
    Next ws
    
     With Application
        
        .ScreenUpdating = True
        .Calculation = CalcMode
        
    End With
End Sub

 

[dmt32]

quick update
in my haste did not fully think about the array I was using. You can modify this piece of code:

From this:

With wsMaster
.Range(.Cells(lr, 2), .Cells(rng1.Count + lr - 1, 2)).Value = unlisted(0)
.Range(.Cells(lr, 3), .Cells(rng1.Count + lr - 1, 3)).Value = unlisted(1)
.Range(.Cells(lr, 4), .Cells(rng1.Count + lr - 1, 4)).Value = unlisted(2)

End With

to this:

With wsMaster
.Range(.Cells(lr, 2), .Cells(rng1.Count + lr - 1, 4)).Value = unlisted
End With

won't make great deal of difference just neater.

Dave