Copy Cells Dynamically to Master Worksheet

[vbanoob1234]

Hi all,

Does anyone know how to copy and paste cells dynamically from multiple worksheets to one master sheet in a workbook.

Here is my problem:

On every worksheet, there is a word called "Payable". I want to copy the info below it (for only column A and B) to another sheet.

Data sample for Account worksheets
Column A Column B
other data above that I don't need to copy and paste to master worksheet
Payable
Class A $100
Class B $50
blank row
other data above that I don't need to copy and paste to master worksheetResults that I would like to achieve on Master worksheet.

Accounts Data (col. A) Data (col. B)
Worksheet Name(1) Class A $100
Worksheet Name(1) Class B $ 50
Worksheet Name(2) Class D $500
Worksheet Name(2) Class F $550
Worksheet Name(2) Class A $600


This is what I got so far. I used the offset function, to find the word "Payable". I need help doing the copying from shift end down, and shift end left to the master sheet.

Second issue: on the master worksheet, how do I get the macro to fill in Column A with the worksheet name X numbers of times, based on how many rows I copied.


Dim master As Worksheet
Dim account As Worksheet
Dim payabletotal As Range


With account.Range("A1:A" & account.Range("A" & account.Rows.Count).End(xlUp).Row)
Set payabletotal = .Find("Payable:", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)

If Not payabletotal Is Nothing Then c.Offset(1, ) = payabletotal.Offset

Else
MsgBox "Worksheet for account " & c.Value & " doesn't exist"
End If

Next

Loop
Application.DisplayAlerts = True


End Sub

 

[mrmmickle1]

Assume data that looks like this:


BEFORE:

Excel 2010
	A	B
1	Header	Header
2
3
Master

Excel 2010
	A	B
1	Header	Header
2
3
4	Payable
5	Class A	100
6	Class B	50
7	Class C	200
Test1

Excel 2010
	A	B
1	Header	Header
2
3
4
5
6
7
8
9	Payable
10	Class E	200
11	Class F	500
12	Class G	600
Test2

AFTER:

Excel 2010
	A	B
1	Header	Header
2	Worksheet: Test1 Class A	100
3	Worksheet: Test1 Class B	50
4	Worksheet: Test1 Class C	200
5	Worksheet: Test2 Class E	200
6	Worksheet: Test2 Class F	500
7	Worksheet: Test2 Class G	600
Master

This code will accomplish your goal. Please pay close attention to notations to grasp the logic of the code:

[COLOR=#0000ff]Sub[/COLOR] Test()


   [COLOR=#0000ff] Dim [/COLOR]sht [COLOR=#0000ff]As[/COLOR] Worksheet
    [COLOR=#0000ff]Dim[/COLOR] shtLrow [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] mstLRow [COLOR=#0000ff]As Long[/COLOR]
   [COLOR=#0000ff] Dim [/COLOR]myPayable [COLOR=#0000ff]As[/COLOR] Range
  [COLOR=#0000ff]  Dim[/COLOR] intLp[COLOR=#0000ff] As Integer[/COLOR]
    
[COLOR=#008000]    'Loop Through Worksheets[/COLOR]
   [COLOR=#0000ff] For[/COLOR] [COLOR=#0000ff]Each[/COLOR] sht [COLOR=#0000ff]In[/COLOR] ThisWorkbook.Worksheets
[COLOR=#008000]        'Check if the worksheet is the Master...if so then skip[/COLOR]
       [COLOR=#0000ff] If[/COLOR] sht.Name <> "Master" [COLOR=#0000ff]Then[/COLOR]
[COLOR=#008000]            'Define LastRows[/COLOR]
            mstLRow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row[COLOR=#008000] 'Define Master Last row[/COLOR]
            shtLrow = sht.Cells(Rows.Count, "A").End(xlUp).Row [COLOR=#008000]'We are assuming that the Payable info is always at the bottom of the sheet[/COLOR]
            
[COLOR=#008000]            'Find the Word "Payable" in column A and set as a range[/COLOR]
            [COLOR=#0000ff]Set [/COLOR]myPayable = sht.Columns(1).Find(What:="Payable", LookIn:=xlValues)
            
[COLOR=#008000]            'If Payable is not found in Column A Skip to next worksheet by going to Skip: Label[/COLOR]
           [COLOR=#0000ff] If[/COLOR] myPayable [COLOR=#0000ff]Is Nothing Then[/COLOR]
                [COLOR=#0000ff]GoTo [/COLOR]Skip
[COLOR=#0000ff]            End If[/COLOR]
            sht.Range("A" & myPayable.Row + 1 & ":B" & shtLrow).Copy Sheets("Master").Range("A" & mstLRow + 1)[COLOR=#008000] 'Copy and Paste Data[/COLOR]
            
[COLOR=#008000]            'Define number of rows copied and pasted...[/COLOR]
            rowCnt = shtLrow - myPayable.Row
            
[COLOR=#008000]            'Add in Worksheet Names to newly pasted range....[/COLOR]
     [COLOR=#0000ff]       For[/COLOR] intLp = mstLRow + 1 [COLOR=#0000ff]To[/COLOR] mstLRow + rowCnt
                Sheets("Master").Cells(intLp, "A") = "Worksheet: " & sht.Name & " " & Sheets("Master").Cells(intLp, "A").Value
            [COLOR=#0000ff]Next[/COLOR] intLp
             
[COLOR=#0000ff]        End If[/COLOR]
Skip:
   [COLOR=#0000ff] Next[/COLOR] sht
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]End Sub[/COLOR]

 

[vbanoob1234]

Assume data that looks like this:


BEFORE:
Excel 2010

	A	B
1	Header	Header
2
3

<tbody>
</tbody>

Master​

Excel 2010

	A	B
1	Header	Header
2
3
4	Payable
5	Class A	100
6	Class B	50
7	Class C	200

<tbody>
</tbody>

Test1​

Excel 2010

	A	B
1	Header	Header
2
3
4
5
6
7
8
9	Payable
10	Class E	200
11	Class F	500
12	Class G	600

<tbody>
</tbody>

Test2​

AFTER:
Excel 2010

	A	B
1	Header	Header
2	Worksheet: Test1 Class A	100
3	Worksheet: Test1 Class B	50
4	Worksheet: Test1 Class C	200
5	Worksheet: Test2 Class E	200
6	Worksheet: Test2 Class F	500
7	Worksheet: Test2 Class G	600

<tbody>
</tbody>

Master​

This code will accomplish your goal. Please pay close attention to notations to grasp the logic of the code:

[COLOR=#0000ff]Sub[/COLOR] Test()


   [COLOR=#0000ff] Dim [/COLOR]sht [COLOR=#0000ff]As[/COLOR] Worksheet
    [COLOR=#0000ff]Dim[/COLOR] shtLrow [COLOR=#0000ff]As Long[/COLOR]
[COLOR=#0000ff]    Dim[/COLOR] mstLRow [COLOR=#0000ff]As Long[/COLOR]
   [COLOR=#0000ff] Dim [/COLOR]myPayable [COLOR=#0000ff]As[/COLOR] Range
  [COLOR=#0000ff]  Dim[/COLOR] intLp[COLOR=#0000ff] As Integer[/COLOR]
    
[COLOR=#008000]    'Loop Through Worksheets[/COLOR]
   [COLOR=#0000ff] For[/COLOR] [COLOR=#0000ff]Each[/COLOR] sht [COLOR=#0000ff]In[/COLOR] ThisWorkbook.Worksheets
[COLOR=#008000]        'Check if the worksheet is the Master...if so then skip[/COLOR]
       [COLOR=#0000ff] If[/COLOR] sht.Name <> "Master" [COLOR=#0000ff]Then[/COLOR]
[COLOR=#008000]            'Define LastRows[/COLOR]
            mstLRow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row[COLOR=#008000] 'Define Master Last row[/COLOR]
            shtLrow = sht.Cells(Rows.Count, "A").End(xlUp).Row [COLOR=#008000]'We are assuming that the Payable info is always at the bottom of the sheet[/COLOR]
            
[COLOR=#008000]            'Find the Word "Payable" in column A and set as a range[/COLOR]
            [COLOR=#0000ff]Set [/COLOR]myPayable = sht.Columns(1).Find(What:="Payable", LookIn:=xlValues)
            
[COLOR=#008000]            'If Payable is not found in Column A Skip to next worksheet by going to Skip: Label[/COLOR]
           [COLOR=#0000ff] If[/COLOR] myPayable [COLOR=#0000ff]Is Nothing Then[/COLOR]
                [COLOR=#0000ff]GoTo [/COLOR]Skip
[COLOR=#0000ff]            End If[/COLOR]
            sht.Range("A" & myPayable.Row + 1 & ":B" & shtLrow).Copy Sheets("Master").Range("A" & mstLRow + 1)[COLOR=#008000] 'Copy and Paste Data[/COLOR]
            
[COLOR=#008000]            'Define number of rows copied and pasted...[/COLOR]
            rowCnt = shtLrow - myPayable.Row
            
[COLOR=#008000]            'Add in Worksheet Names to newly pasted range....[/COLOR]
     [COLOR=#0000ff]       For[/COLOR] intLp = mstLRow + 1 [COLOR=#0000ff]To[/COLOR] mstLRow + rowCnt
                Sheets("Master").Cells(intLp, "A") = "Worksheet: " & sht.Name & " " & Sheets("Master").Cells(intLp, "A").Value
            [COLOR=#0000ff]Next[/COLOR] intLp
             
[COLOR=#0000ff]        End If[/COLOR]
Skip:
   [COLOR=#0000ff] Next[/COLOR] sht
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]End Sub[/COLOR]

Hi Mike Mickle,

Sorry. I wasn't being clear on my initial post.
The payable data is not always at the end. There are some other data after it

eg.
Test 1 worksheet.

Col A	Col B
blah	blah
Payable
Class A	100
Class B	200
blah	blah

<tbody>
</tbody>

As well, essentially, I want my master sheet to look like this.

Column A	Column B	Column C
Worksheet Name	Class:	Amount:
Test 1	Class A	100
Test 1	Class B	200
and so forth

<tbody>
</tbody>

Thank you for your help Mike. I like your style of code. It is very understandable.

 

[vbanoob1234]

Hi Mike Mickle,

Sorry. I wasn't being clear on my initial post.
The payable data is not always at the end. There are some other data after it

eg.
Test 1 worksheet.

Col A	Col B
blah	blah
Payable
Class A	100
Class B	200
blah	blah

<tbody>
</tbody>

As well, essentially, I want my master sheet to look like this.

Column A	Column B	Column C
Worksheet Name	Class:	Amount:
Test 1	Class A	100
Test 1	Class B	200
and so forth

<tbody>
</tbody>

Thank you for your help Mike. I like your style of code. It is very understandable.

This is what I got thusfar.



Dim sht As Worksheet
Dim shtLrow As Long
Dim mstLRow As Long
Dim myPayable As Range
Dim intLp As Integer
Dim i As Long

'Loop Through Worksheets in the Workbook
For Each sht In ThisWorkbook.Worksheets

'Check if the worksheet is the Master...if so then skip
If sht.Name <> "Master" Then
'Define LastRows
mstLRow = Sheets("Master").Cells(Rows.Count, "B").End(xlUp).Row 'Define Master LastRow
'shtLrow = sht.Cells(Rows.Count, "A").End(xlUp).Row 'We are assuming that the Payable info is always at the bottom of the sheet

'Find the Word "Payable" in column A and set as a range
Set myPayable = sht.Columns(1).Find(What:="Payable", LookIn:=xlValues)

'If Payable is not found in Column A, Skip to next worksheet by going to Skip: Label
If myPayable Is Nothing Then
GoTo Skip
End If


'sht.Range("A" & myPayable.Row + 1 & ":B" & shtLrow).Copy Sheets("Master").Range("A" & mstLRow + 1) 'Copy and Paste Data
'took everything below payable. + 1, B and sht lrow



i = myPayable.Row + 1


Do Until sht.Cells(i, 1).Value = ""


Sheets("master").Range("B" & mstLRow + 1) = sht.Range("A" & i & ":B" & i).Value


i = i + 1
Loop


'Define number of rows copied and pasted...
rowCnt = shtLrow - myPayable.Row


'Add in Worksheet Names to newly pasted range.
For intLp = mstLRow + 1 To mstLRow + rowCnt
Sheets("Master").Cells(intLp, "A") = sht.Name

Next intLp

End If
Skip:
Next sht




End Sub

 

[mrmmickle1]

These updates should fix your issue:

Sub Test()


    Dim sht As Worksheet
    Dim shtLrow As Long
    Dim mstLRow As Long
    Dim myPayable As Range
    Dim intLp As Integer
[COLOR=#ff0000]    Dim payLp As Integer[/COLOR]
[COLOR=#ff0000]    Dim payLRow As Integer[/COLOR]
    
    'Loop Through Worksheets
    For Each sht In ThisWorkbook.Worksheets
        'Check if the worksheet is the Master...if so then skip
        If sht.Name <> "Master" Then
            'Define LastRows
            mstLRow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row 'Define Master Last row
            shtLrow = sht.Cells(Rows.Count, "A").End(xlUp).Row 'We are assuming that the Payable info is always at the bottom of the sheet
            
            'Find the Word "Payable" in column A and set as a range
            Set myPayable = sht.Columns(1).Find(What:="Payable", LookIn:=xlValues)
            
            'If Payable is not found in Column A Skip to next worksheet by going to Skip: Label
            If myPayable Is Nothing Then
                GoTo Skip
            End If
            
[COLOR=#ff0000]            'Find Last Row of Payable Data[/COLOR]
[COLOR=#ff0000]            For payLp = myPayable.Row To shtLrow[/COLOR]

[COLOR=#ff0000]                If sht.Cells(payLp, "A") = "" Then[/COLOR]
[COLOR=#ff0000]                    payLRow = payLp - 1[/COLOR]
[COLOR=#ff0000]                End If[/COLOR]

        [COLOR=#ff0000]    Next payLp[/COLOR]
            
[COLOR=#ff0000]            sht.Range("A" & myPayable.Row + 1 & ":B" & payLRow).Copy Sheets("Master").Range("A" & mstLRow + 1) 'Copy and Paste Data[/COLOR]

[COLOR=#ff0000]            'Define number of rows copied and pasted...[/COLOR]
[COLOR=#ff0000]            rowCnt = payLRow - myPayable.Row[/COLOR]
            
            'Add in Worksheet Names to newly pasted range....
            For intLp = mstLRow + 1 To mstLRow + rowCnt
                Sheets("Master").Cells(intLp, "A") = "Worksheet: " & sht.Name & " " & Sheets("Master").Cells(intLp, "A").Value
            Next intLp
             
        End If
Skip:
    Next sht
    
End Sub