VBA to clear contents, paste into another worksheet based on criteria

B

bxs12985

New Member
Joined
Aug 27, 2017
Messages
3
I have data in a tab, called "SourceData" in the following order:
[TABLE="width: 452"]
<colgroup><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]
[TABLE="width: 452"]
<colgroup><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Curr[/TD]
[TD]Company[/TD]
[TD]Department[/TD]
[TD]Account[/TD]
[TD]Account Name[/TD]
[TD]Jan[/TD]
[TD]Feb[/TD]
[TD]Mar[/TD]
[TD]Apr[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55100[/TD]
[TD]Salaries 1[/TD]
[TD="align: right"]500[/TD]
[TD="align: right"]400[/TD]
[TD="align: right"]230[/TD]
[TD="align: right"]120[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55110[/TD]
[TD]Salaries 2[/TD]
[TD="align: right"]500[/TD]
[TD="align: right"]400[/TD]
[TD="align: right"]230[/TD]
[TD="align: right"]120[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55120[/TD]
[TD]Salaries 3[/TD]
[TD="align: right"]500[/TD]
[TD="align: right"]400[/TD]
[TD="align: right"]230[/TD]
[TD="align: right"]120[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55130[/TD]
[TD]Salaries 4[/TD]
[TD="align: right"]500[/TD]
[TD="align: right"]400[/TD]
[TD="align: right"]230[/TD]
[TD="align: right"]120[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]120[/TD]
[TD="align: right"]55140[/TD]
[TD]Salaries 5[/TD]
[TD="align: right"]500[/TD]
[TD="align: right"]400[/TD]
[TD="align: right"]230[/TD]
[TD="align: right"]120[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55150[/TD]
[TD]Salaries 6[/TD]
[TD="align: right"]540[/TD]
[TD="align: right"]440[/TD]
[TD="align: right"]270[/TD]
[TD="align: right"]160[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55160[/TD]
[TD]Salaries 7[/TD]
[TD="align: right"]540[/TD]
[TD="align: right"]440[/TD]
[TD="align: right"]270[/TD]
[TD="align: right"]160[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55170[/TD]
[TD]Salaries 8[/TD]
[TD="align: right"]540[/TD]
[TD="align: right"]440[/TD]
[TD="align: right"]270[/TD]
[TD="align: right"]160[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]55180[/TD]
[TD]Salaries 9[/TD]
[TD="align: right"]540[/TD]
[TD="align: right"]440[/TD]
[TD="align: right"]270[/TD]
[TD="align: right"]160[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55190[/TD]
[TD]Salaries 10[/TD]
[TD="align: right"]540[/TD]
[TD="align: right"]440[/TD]
[TD="align: right"]270[/TD]
[TD="align: right"]160[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55200[/TD]
[TD]Salaries 11[/TD]
[TD="align: right"]580[/TD]
[TD="align: right"]480[/TD]
[TD="align: right"]310[/TD]
[TD="align: right"]200[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55210[/TD]
[TD]Salaries 12[/TD]
[TD="align: right"]580[/TD]
[TD="align: right"]480[/TD]
[TD="align: right"]310[/TD]
[TD="align: right"]200[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55220[/TD]
[TD]Salaries 13[/TD]
[TD="align: right"]580[/TD]
[TD="align: right"]480[/TD]
[TD="align: right"]310[/TD]
[TD="align: right"]200[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55230[/TD]
[TD]Salaries 14[/TD]
[TD="align: right"]580[/TD]
[TD="align: right"]480[/TD]
[TD="align: right"]310[/TD]
[TD="align: right"]200[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55240[/TD]
[TD]Salaries 15[/TD]
[TD="align: right"]580[/TD]
[TD="align: right"]480[/TD]
[TD="align: right"]310[/TD]
[TD="align: right"]200[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]200[/TD]
[TD="align: right"]55250[/TD]
[TD]Salaries 16[/TD]
[TD="align: right"]620[/TD]
[TD="align: right"]520[/TD]
[TD="align: right"]350[/TD]
[TD="align: right"]240[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]250[/TD]
[TD="align: right"]55260[/TD]
[TD]Salaries 17[/TD]
[TD="align: right"]620[/TD]
[TD="align: right"]520[/TD]
[TD="align: right"]350[/TD]
[TD="align: right"]240[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]250[/TD]
[TD="align: right"]55270[/TD]
[TD]Salaries 18[/TD]
[TD="align: right"]620[/TD]
[TD="align: right"]520[/TD]
[TD="align: right"]350[/TD]
[TD="align: right"]240[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]250[/TD]
[TD="align: right"]55280[/TD]
[TD]Salaries 19[/TD]
[TD="align: right"]620[/TD]
[TD="align: right"]520[/TD]
[TD="align: right"]350[/TD]
[TD="align: right"]240[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]250[/TD]
[TD="align: right"]55290[/TD]
[TD]Salaries 20[/TD]
[TD="align: right"]620[/TD]
[TD="align: right"]520[/TD]
[TD="align: right"]350[/TD]
[TD="align: right"]240[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55300[/TD]
[TD]Salaries 21[/TD]
[TD="align: right"]660[/TD]
[TD="align: right"]560[/TD]
[TD="align: right"]390[/TD]
[TD="align: right"]280[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55310[/TD]
[TD]Salaries 22[/TD]
[TD="align: right"]660[/TD]
[TD="align: right"]560[/TD]
[TD="align: right"]390[/TD]
[TD="align: right"]280[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55320[/TD]
[TD]Salaries 23[/TD]
[TD="align: right"]660[/TD]
[TD="align: right"]560[/TD]
[TD="align: right"]390[/TD]
[TD="align: right"]280[/TD]
[/TR]
[TR]
[TD]EUR[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55330[/TD]
[TD]Salaries 24[/TD]
[TD="align: right"]660[/TD]
[TD="align: right"]560[/TD]
[TD="align: right"]390[/TD]
[TD="align: right"]280[/TD]
[/TR]
[TR]
[TD]CNY[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55340[/TD]
[TD]Salaries 25[/TD]
[TD="align: right"]660[/TD]
[TD="align: right"]560[/TD]
[TD="align: right"]390[/TD]
[TD="align: right"]280[/TD]
[/TR]
[TR]
[TD]CNY[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55350[/TD]
[TD]Salaries 26[/TD]
[TD="align: right"]700[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]430[/TD]
[TD="align: right"]320[/TD]
[/TR]
[TR]
[TD]CNY[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55360[/TD]
[TD]Salaries 27[/TD]
[TD="align: right"]700[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]430[/TD]
[TD="align: right"]320[/TD]
[/TR]
[TR]
[TD]CNY[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55370[/TD]
[TD]Salaries 28[/TD]
[TD="align: right"]700[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]430[/TD]
[TD="align: right"]320[/TD]
[/TR]
[TR]
[TD]CNY[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]300[/TD]
[TD="align: right"]55380[/TD]
[TD]Salaries 29[/TD]
[TD="align: right"]700[/TD]
[TD="align: right"]600[/TD]
[TD="align: right"]430[/TD]
[TD="align: right"]320[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

If Column A is USD and Column C is Dept 100, I'd like to copy every row and column in the "SourceData" tab that fits that criteria and put it in a "100 USD" tab.

Just curious what the VBA looks like to clear contents of every tab and then using multiple criteria (column A and Column C) to paste into respective tabs.

Let me know if there's any questions. Thank you!
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
Try either of these, sub a or sub b. you probably want sub b.

Copy to a standard module.

I'm looking into this now.

Just curious what the VBA looks like to clear contents of every tab and then using multiple criteria (column A and Column C) to paste into respective tabs.
Click to expand...

Howard


Code: 
Sub CopyStuff_a()
Dim OneRng As Range
Dim c As Range

Set OneRng = Sheets("SourceData").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each c In OneRng
  
  If c = "USD" And c.Offset(, 2) = 100 Then
    c.EntireRow.Copy Sheets("100 USD").Range("A" & c.Row)
  End If
  
Next
End Sub


Sub CopyStuff_b() '// no blank rows
Dim OneRng As Range
Dim c As Range

Set OneRng = Sheets("SourceData").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each c In OneRng
  
  If c = "USD" And c.Offset(, 2) = 100 Then
    c.EntireRow.Copy Sheets("100 USD").Range("A" & Rows.Count).End(xlUp)(2)
  End If
  
Next
End Sub
 
Upvote 0
bxs12985 said:
Just curious what the VBA looks like to clear contents of every tab and then using multiple criteria (column A and Column C) to paste into respective tabs.

Let me know if there's any questions. Thank you!
Click to expand...

How are the "respective tabs" named?

100 USD, 120 USD, 200 USD, 100 EUR, 200 EUR, 250 EUR etc.
or
USD, EUR, CNY

Howard
 
Upvote 0
Thanks Howard.

Sub b worked perfectly. The tabs are 110 USD, 115 USD, etc.

One thing I did notice is that the headers did not come through and it is not pasting as special values. Any ideas on how to incorporate this into sub b?

Thanks,
Brandon
 
Upvote 0
L. Howard said:
100 USD, 120 USD, 200 USD, 100 EUR, 200 EUR, 250 EUR etc.
Click to expand...

I assumed the other sheets are named as seen here above...

See the example at bottom of code if you have several sheets you DO NOT WANT CLEARED. You would use that format/syntax to skip sheets not wanted cleared in the Case and the Case Else will clear all cells in all sheets.

Howard

Code: 
Sub CopyStuff_SheetX()
Dim OneRng As Range
Dim c As Range, cc As String
Dim Dep As Long
Dim ws As Worksheet

For Each ws In Worksheets

    Select Case ws.Name

    Case "SourceData"
        ' do nothing

    Case Else
        ws.Cells.ClearContents

    End Select

Next ws

Set OneRng = Sheets("SourceData").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)


For Each c In OneRng
     cc = c
 
   If Not c Is Nothing Then
     Dep = c.Offset(, 2)
  
     c.EntireRow.Copy Sheets(Dep & " " & cc).Range("A" & Rows.Count).End(xlUp)(2)
       'Dep = USD, EUR etc. and cc = 100, 120, 200, 250 as the case may be and the " " is the space in the tab name.

   End If

Next

End Sub


    '/ multi sheets NOT to CLEAR example
    '  [I][B] Case "SourceData", "Sheet1", "Sheet2", "Sheet_with_Funny_Name", "333 Counterfeit"
              ' do nothing[/B][/I]
 
Upvote 0
try this for the paste special...
Howard

Code: 
Sub CopyStuff_SheetX()
Dim OneRng As Range
Dim c As Range, cc As String
Dim Dep As Long
Dim ws As Worksheet

For Each ws In Worksheets

    Select Case ws.Name

    Case "SourceData"
        ' do nothing

    Case Else
        ws.Cells.ClearContents

    End Select

Next ws

Set OneRng = Sheets("SourceData").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

Application.ScreenUpdating = False

For Each c In OneRng
     cc = c
 
   If Not c Is Nothing Then
     Dep = c.Offset(, 2)
  
     c.EntireRow.Copy
     Sheets(Dep & " " & cc).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
    
   End If

Next

Application.ScreenUpdating = True
End Sub
 
Upvote 0
[TABLE="width: 500"]
<tbody>[TR]
[TD]Currency[/TD]
[TD]Company[/TD]
[TD]Dept[/TD]
[TD]Account[/TD]
[TD]Acct Description[/TD]
[TD]Expense Type[/TD]
[TD]Location[/TD]
[TD]Category[/TD]
[TD]Expense Category[/TD]
[TD]Jan 2013[/TD]
[TD]Feb 2013[/TD]
[TD]Mar 2013[/TD]
[/TR]
[TR]
[TD]USD
USD
USD
EUR
EUR
EUR
CNY
CNY
CNY
[/TD]
[TD]2
3
5
30
32
36
40
42
50[/TD]
[TD]100
105
108
100
105
108
100
105
108[/TD]
[TD]60000
60000
60000
60000
60000
60000
60000
60000
60000
[/TD]
[TD]Payroll
Payroll
Payroll
Payroll
Payroll
Payroll
Payroll
Payroll
Payroll[/TD]
[TD]G&A
G&A
G&A
G&A
G&A
G&A
G&A
G&A
G&A[/TD]
[TD]LosAng
LosAng
LosAng
Ireland
Ireland
Ireland
HongKong
HongKong
HongKong[/TD]
[TD]Salaries
Salaries
Salaries
Salaries
Salaries
Salaries
Salaries
Salaries
Salaries[/TD]
[TD]x
x
x
x
x
x
x
x
x
[/TD]
[TD]500
500
500
500
500
500
500
500
500[/TD]
[TD]500
500
500
500
500
500
500
500
500[/TD]
[TD]500
500
500
500
500
500
500
500
500[/TD]
[/TR]
</tbody>[/TABLE]


Here's how my data is set up and it is in a table.
The tabs are 100 Los Angeles USD, 105 Los Angeles USD, 108 Los Angeles USD, 100 Ireland EUR, 105 Ireland EUR, 108 Ireland EUR, 100 Hong Kong CNY, 105 Hong Kong CNY, 108 Hong Kong CNY

[TABLE="width: 500"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Criteria[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 374"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Los Angeles USD - company 2, 3, 5[/TD]
[/TR]
[TR]
[TD]Ireland EUR - company 30, 32, 36[/TD]
[/TR]
[TR]
[TD]Hong Kong CNY - copmany 40, 42, 50

[TABLE="width: 374"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Tabs are in the format of (Dept, Location, Currency)[/TD]
[/TR]
[TR]
[TD]Tabs are in the format of (Column C, Column G, Column A)

Hope this clarifies.[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
If you can change the tab names to reflect the city as show exactly in column G like these examples, I may be able to adapt the code to chase down the proper tab to copy the row to.

100 HongKong CNY

108 LosAng USD

105 Ireland EUR

etc.

Howard
 
Last edited:
Upvote 0
Try this, where the sheets tabs are named as such for a short example...

100 HongKong CNY
100 LosAng USD
105 Ireland EUR
108 LosAng USD

Howard

Code: 
Sub CopyStuff_SheetX_v1()
Dim OneRng As Range, Hdr As Range
Dim c As Range
Dim Loc As String, Cur As String
Dim Dep As Long, hCol As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In Worksheets

    Select Case ws.Name

      Case "SourceData"
        ' do nothing

      Case Else
        ws.Cells.ClearContents

    End Select

Next ws

hCol = Cells.Find(What:="*", After:=[A1], _
              SearchOrder:=xlByColumns, _
              SearchDirection:=xlPrevious).Column
                       
Set OneRng = Sheets("SourceData").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set Hdr = Sheets("SourceData").Range("A1").Resize(1, hCol)

For Each c In OneRng
     Cur = c
 
   If Not c Is Nothing Then

     Dep = c.Offset(, 2)
     Loc = c.Offset(, 6)
  
     c.EntireRow.Copy
     Sheets(Dep & " " & Loc & " " & Cur).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
     Hdr.Copy Sheets(Dep & " " & Loc & " " & Cur).Range("A1")
     
   End If

Next

Application.ScreenUpdating = True

End Sub

    '/ multi sheets NOT to CLEAR example
    '   Case "SourceData", "Sheet1", "Sheet2", "Sheet_with_Funny_Name", "333 Counterfeit"
    '        do nothing
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
Copy and Paste Multiple sheet data in one sheet Formula
Replies
7
Views
342
vishu
V
D
  • Question Question
How to Copy rows from one sheet to another based on the criteria in the second sheet
Replies
9
Views
177
dsubash
D
A
  • Solved
Extraction last row based on specific words and put in account column(debit,credit)
Replies
4
Views
199
Alaa mg
A
M
  • Solved
VBA Transpose data from one sheet into another
Replies
9
Views
634
madi1004
M
S
  • Question Question
Pro Rata a Sumproduct Calculation
Replies
1
Views
324
myall_blues
myall_blues

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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