macro to copy / paste a series of date

jkrenkel

New Member
Joined
Apr 25, 2006
Messages
23
I am looking for a macro to do the following. In theory, this is what it should do

Sheet 1 - look in column b
If column b = Income then it would take Column C and Column D, copy it, go to sheet 2, paste it into the next empty row and then repeat it until all the data is looked at and copied correctly. A new report will be running daily so it almost acts like a statement of transactions.

I know there is a For loop in this thing, but when i do it, it pastes it into sheet 1, and then deletes it right away. This code is terrible, so any help will be appreciated. Thanks

Code:
Dim cell As Range

Dim cell1 As Range
Dim AssetNumber As Long

AssetNumber = Sheet1.Range("c2:c" & Sheet1.Range("c65536").End(xlUp).Row).Count

Sheet3.Select

' Loop for each row in selection.
For Each cell In Sheet3.Range("e3", Cells(65535, Sheet3.Range("e65536").End(xlToLeft).Column).End(xlUp))
    
cell.Offset(0, 1).Copy

For Each cell1 In Sheet1.Range("c2:c" & Sheet1.Range("c65536").End(xlToLeft).Column).End(xlUp)

Cells(AssetNumber + 1, 2).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
Next cell1
Next cell
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Your code doesn't seem to do anything you describe:

1. There is no test for the word "Income".
2. You are copying from Sheet3 column E, not Sheet1 columns C:D.
3. You are pasting in Sheet1 not Sheet2.
4. I'm unclear why you have a loop within a loop.

See if this gets you closer to what you want:

Code:
Sub Test()
    Dim Sh1 As Worksheet
    Dim Rng1 As Range
    Dim Sh2 As Worksheet
    Dim Rng2 As Range
    Set Sh1 = Worksheets("Sheet1")
    Set Rng1 = Sh1.Range("B1:B" & Sh1.Range("B" & Sh1.Rows.Count).End(xlUp).Row)
    Set Sh2 = Worksheets("Sheet2")
    Set Rng2 = Sh2.Range("A" & Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row).Offset(1, 0)
    Rng1.AutoFilter
    Rng1.AutoFilter Field:=1, Criteria1:="Income"
    Set Rng1 = Rng1.Offset(0, 1).Resize(, 2)
    Rng1.SpecialCells(xlCellTypeVisible).Copy
    Rng2.PasteSpecial xlValues
    Sh1.AutoFilterMode = False
    Application.CutCopyMode = False
End Sub
 

jkrenkel

New Member
Joined
Apr 25, 2006
Messages
23
Thanks, I will test this out. I was just toying around with some codes i used in the past, and had not gotten to the income part. One day i will actually get a book on this or take a class.
 

jkrenkel

New Member
Joined
Apr 25, 2006
Messages
23
Ok so it copies and pastes, but how do I get this to loop though source worksheet and paste into the data worksheet. There is probably going to be 50 entries of data a day. So I would like this to verify the data, copy it, paste it into the data worksheet, then go back to the source, find the next valid line and roll through it that way.

That is why I had my original loop in there.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092

ADVERTISEMENT

My code uses AutoFilter to show only the rows with the text "Income" in column B. It then copies and pastes those records in one go.

So why do you need a loop?
 

jkrenkel

New Member
Joined
Apr 25, 2006
Messages
23

ADVERTISEMENT

Andrew,

Taking this a step further, if I autofilter a rng series from another worksheet, basically compare the data and get a match. I am freezing my macro when the value from sheet 1 is not pulling any matches from sheet 2. I need it to get back into the loop if it cannot find it. Here is my code

Code:
Sub do_it()

 
 Dim i As Integer
 Dim j As Integer
 
 Dim Sh1 As Worksheet
  Dim rng1 As Range
  
  Dim Sh2 As Worksheet
  Dim rng2 As Range
  
i = 2



Set Sh1 = Sheet2 ' BNY Acct List
Set rng1 = Sh1.Range("a1:a" & Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row)

Set Sh2 = Sheet1
Set rng2 = Sh2.Cells(i, 1) ' JPM Acct List - Paste Data here

rng2.Select

 
 
 
Do

If IsEmpty(rng2) Then Exit Do

'Sh1.Activate
rng1.AutoFilter
    rng1.AutoFilter Field:=1, Criteria1:=rng2.Value
    

    Set rng1 = rng1.Offset(1, 1).Resize(, 2)
    
   rng1.SpecialCells(xlCellTypeVisible).Copy
  
   
   
   'Sh2.Activate
   Set rng2 = rng2.Offset(, 1).Resize(, 2)
   rng2.Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    Sh1.AutoFilterMode = False
    Application.CutCopyMode = False
    
 i = i + 1
 Set rng2 = Cells(i, 1)
 Set rng1 = Sh1.Range("a1:a" & Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row)
 
  Loop
 
 
    
End Sub
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Soory, what does "I am freezing my macro when the value from sheet 1 is not pulling any matches from sheet 2" mean?
 

jkrenkel

New Member
Joined
Apr 25, 2006
Messages
23
It crashes excel, gives me a not repsonding message and I have to manually exit excel.

So when it loops through the macro, it works great. Then it hits a number that has no matches, and just sits there until I close excel.
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
I don't know why that should happen, but I would expect an error if no visible cells were found. Try the untested:

Code:
Sub do_it() 
   Dim i As Integer 
   Dim j As Integer 
   Dim Sh1 As Worksheet 
   Dim rng1 As Range 
   Dim Sh2 As Worksheet 
   Dim rng2 As Range 
   i = 2 
   Set Sh1 = Sheet2 ' BNY Acct List 
   Set rng1 = Sh1.Range("a1:a" & Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row) 
   Set Sh2 = Sheet1 
   Set rng2 = Sh2.Cells(i, 1) ' JPM Acct List - Paste Data here 
   rng2.Select 
   Do 
      If IsEmpty(rng2) Then Exit Do 
'      Sh1.Activate 
      rng1.AutoFilter 
      rng1.AutoFilter Field:=1, Criteria1:=rng2.Value 
      Set rng1 = rng1.Offset(1, 1).Resize(, 2) 
      On Error Resume Next
      rng1.SpecialCells(xlCellTypeVisible).Copy 
      If Err = 0 Then
'         Sh2.Activate 
         Set rng2 = rng2.Offset(, 1).Resize(, 2) 
         rng2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
         Sh1.AutoFilterMode = False 
         Application.CutCopyMode = False 
      Else
         Err.Clear
      End If    
      On Error GoTo 0
      i = i + 1 
      Set rng2 = Cells(i, 1) 
      Set rng1 = Sh1.Range("a1:a" & Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row) 
   Loop 
End Sub
 

Forum statistics

Threads
1,144,388
Messages
5,724,069
Members
422,533
Latest member
garganod1

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
Top