PDA

View Full Version : Nested loops and populating a new ws with the items



cleareyes
10-16-2012, 10:18 AM
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 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.

p45cal
10-16-2012, 05:55 PM
try (untested):Sub blah()
Dim rngToCopy As Range
Dim ws As Worksheet
Dim i As Long
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Transaction List" Then
Set rngToCopy = Nothing
i = 12 'this resets the counter for each sheet.
Do While (ws.Cells(i, 4) <> "")
Set rngToCopy = ws.Range("D12:D" & i)
i = i + 1
Loop
If Not rngToCopy Is Nothing Then
With Sheets("Transaction List")
DestnRow = Application.Max(.Cells(.Rows.Count, "F").End(xlUp).Row + 1, 6) 'this decides what row to paste to.
rngToCopy.Copy .Cells(DestnRow, "F")
End With
End If
End If
Next ws
End Sub
(I've stuck with your Do While loop to ascertain what to copy, but there may be faster ways; I just wasn't sure if there was definitely always going to be something in D12 on each sheet, nor whether there was always going to be something in D13, nor whether there was anything below the first blank cell encountered while running down column D that you didn't want to copy.)

Teeroy
10-16-2012, 06:11 PM
Or alternatively,if you want all data in the columns (which may include spaces before the end):

Sub Macro2()
Dim ws As Worksheet
Dim rDest As Range

Set rDest = Sheets("Transaction List").Range("F6")
For Each ws In ThisWorkbook.Worksheets
On Error Resume Next
If ws.Name <> "Transaction List" Then
ws.Range("D12:" & ws.Range("d" & Rows.Count).End(xlUp).Address).Copy rDest
Set rDest = Sheets("Transaction List").Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next ws
End Sub