vba macro to copy data

[colbecd]

Hi

please can you help me with the below...

in worksheet1 i have data that looks very similar to the below

customer index ccy amt acc
a aa eur 1234 12345
a aa eur 1234 12345
a aa eur 1234 12345
b bb usd 2345 25637
b bb usd 2345 25637
etc....


i want to copy the data to worksheet2 in blocks of data by customer and then to run a macro i have already called balance, then go back to worksheet one and copy the next block of data and repeat the macro called balance looping until there are no more customers.

hope that makes sense and any help anyone can give me would be amazing

 

[rpaulson]

Here is a quick solution that may work.


try on a backup copy

I had to create some "Helper Columns"

Copy the heading from sheet1 cell A1 to cell I1
Copy the heading from sheet 1 range a1:e1 to Range m1: e1

Sub Macro1()

Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")


 ws2.Activate
 ws1.Range("A:E").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws1.Range("I1"), Unique:=True 'Create Unique Customers
    
For r = 1 To ws1.Range("I65536").End(xlUp).Row

ws2.Range("A2:E5000").ClearContents
ws1.Columns("A:E").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws1.Range("I1:I2"), CopyToRange:=ws1.Range("M1:Q1"), Unique:=False
   
    
lr = ws1.Range("M65536").End(xlUp).Row
ws2.Range("A2:E" & lr).Value = ws1.Range("M2:Q" & lr).Value
  
  
  
  
  MsgBox "your code here"
   
    
ws1.Range("I2").Delete Shift:=xlUp
Next r
    
End Sub

hth,

Ross

 

[AlphaFrog]

Another one. Set the destination cell on Sheet2 to suit.

[COLOR=darkblue]Sub[/COLOR] Copy_Customer_Data()
    
    [COLOR=darkblue]Dim[/COLOR] rngCustomers [COLOR=darkblue]As[/COLOR] Range, rngCust [COLOR=darkblue]As[/COLOR] Range, LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], rngDest [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] rngDest = [B]Sheets("Sheet2").Range("A2")[/B]
    
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet1")
        
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=[COLOR=darkblue]True[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rngCustomers = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
        [COLOR=darkblue]If[/COLOR] .FilterMode [COLOR=darkblue]Then[/COLOR] .ShowAllData
        
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] rngCust [COLOR=darkblue]In[/COLOR] rngCustomers
            .Range("A1:A" & LastRow).AutoFilter 1, rngCust.Value
            [COLOR=darkblue]With[/COLOR] .Range("A2:E" & LastRow).SpecialCells(xlCellTypeVisible)
                .Copy Destination:=rngDest
                [COLOR=darkblue]Call[/COLOR] Balance
                [COLOR=green]'Clear data[/COLOR]
                rngDest.Resize(.Rows.Count, .Columns.Count).ClearContents
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=darkblue]Next[/COLOR]
        .AutoFilterMode = [COLOR=darkblue]False[/COLOR]
        
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
[COLOR=darkblue]Sub[/COLOR] Balance()
    [COLOR=green]'your code here[/COLOR]
[COLOR=darkblue]End[/COLOR] Sub