VBA to copy data from a sheet1 and sheet2 to different tabs

[Abhishekghorpade]

[FONT=&quot]Hi,[/FONT]
[FONT=&quot]I have amounts in Sheet1 ‘column D’ and Sheet2 ‘column C’, I want to copy and paste the amount in following tabs in column B and column F with the below criteria.[/FONT]

[FONT=&quot]Criteria to be match is date and plan ID (Which is in H1 in all tabs). [/FONT]

[FONT=&quot]Thank you so much in advance[/FONT]

 

[Abhishekghorpade]

ok, Then you must convert the date to dd/mm/yyyy.
Use the following macro:

Sub Copy_Data()
    Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
    Dim f As Range, d As Range, mount As Double, wdate As Date
    
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    
    For Each sh In Sheets
        If sh.Name <> sh1.Name And sh.Name <> sh2.Name Then
            num = sh.Range("H1").Value
            
            'search in sheet1
            Set f = sh1.Range("A:A").Find(num, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                mount = f.Offset(, 3).Value
                wdate = f.Offset(, 1).Value
                Set d = sh.Range("A:A").Find(wdate, LookIn:=xlValues, lookat:=xlWhole)
                If Not d Is Nothing Then
                    sh.Cells(d.Row, "B").Value = mount
                End If
            End If
        
            'search in sheet2
            Set f = sh2.Range("A:A").Find(num, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                mount = f.Offset(, 2).Value
                wdate = f.Offset(, 1).Value
                Set d = sh.Range("A:A").Find(wdate, LookIn:=xlValues, lookat:=xlWhole)
                If Not d Is Nothing Then
                    sh.Cells(d.Row, "F").Value = mount
                End If
            End If
        End If
    Next
    MsgBox "End"
End Sub

File test:

https://www.dropbox.com/s/2wqrhyfdgfjebkh/GGI - Daily Earnings dam.xlsm?dl=0

Thank you so much .. Thats exactly what I was looking for.. you made my life easy

 

[DanteAmor]

Thank you so much .. Thats exactly what I was looking for.. you made my life easy

I'm glad to help you. Thanks for the feedback.

 

[Abhishekghorpade]

I'm glad to help you. Thanks for the feedback.

Sorry I wanted a small thing to add.... Can we have zero in column B or F if there is no value.. Currently its showing blank instead of blank cell can we fill with zero ?

 

[DanteAmor]

Sorry I wanted a small thing to add.... Can we have zero in column B or F if there is no value.. Currently its showing blank instead of blank cell can we fill with zero ?

Try this

Sub Copy_Data()
    Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
    Dim f As Range, d As Range, mount As Double, wdate As Date
    
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    
    For Each sh In Sheets
        If sh.Name <> sh1.Name And sh.Name <> sh2.Name Then
            num = sh.Range("H1").Value
            
            'search in sheet1
            Set f = sh1.Range("A:A").Find(num, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                mount = f.Offset(, 3).Value
                wdate = f.Offset(, 1).Value
                Set d = sh.Range("A:A").Find(wdate, LookIn:=xlValues, lookat:=xlWhole)
                If Not d Is Nothing Then
                    if mount = "" then mount = 0
                    sh.Cells(d.Row, "B").Value = mount
                End If
            End If
        
            'search in sheet2
            Set f = sh2.Range("A:A").Find(num, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                mount = f.Offset(, 2).Value
                wdate = f.Offset(, 1).Value
                Set d = sh.Range("A:A").Find(wdate, LookIn:=xlValues, lookat:=xlWhole)
                If Not d Is Nothing Then
                    if mount = "" then mount = 0
                    sh.Cells(d.Row, "F").Value = mount
                End If
            End If
        End If
    Next
    MsgBox "End"
End Sub

 

[Abhishekghorpade]

Try this

Sub Copy_Data()
    Dim sh As Worksheet, sh1 As Worksheet, sh2 As Worksheet
    Dim f As Range, d As Range, mount As Double, wdate As Date
    
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    
    For Each sh In Sheets
        If sh.Name <> sh1.Name And sh.Name <> sh2.Name Then
            num = sh.Range("H1").Value
            
            'search in sheet1
            Set f = sh1.Range("A:A").Find(num, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                mount = f.Offset(, 3).Value
                wdate = f.Offset(, 1).Value
                Set d = sh.Range("A:A").Find(wdate, LookIn:=xlValues, lookat:=xlWhole)
                If Not d Is Nothing Then
                    if mount = "" then mount = 0
                    sh.Cells(d.Row, "B").Value = mount
                End If
            End If
        
            'search in sheet2
            Set f = sh2.Range("A:A").Find(num, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                mount = f.Offset(, 2).Value
                wdate = f.Offset(, 1).Value
                Set d = sh.Range("A:A").Find(wdate, LookIn:=xlValues, lookat:=xlWhole)
                If Not d Is Nothing Then
                    if mount = "" then mount = 0
                    sh.Cells(d.Row, "F").Value = mount
                End If
            End If
        End If
    Next
    MsgBox "End"
End Sub

Its giving me an error as "Type mismatch" Coding is stopping at "if mount = "" then mount = 0"

 

[DanteAmor]

Its giving me an error as "Type mismatch" Coding is stopping at "if mount = "" then mount = 0"

Change this

mount As Double

By:

mount As Variant

 

[Abhishekghorpade]

Change this

mount As Double

By:

mount As Variant

Code is working but I wanted the zero if the plan ID is missing in sheet1 or sheet2. Ex: In sheet 'Anderson Heating' There is no value in column F and that is showing as blank I want zero instead of blank. Same goes in sheet ‘Wilcox’

 

[DanteAmor]

Code is working but I wanted the zero if the plan ID is missing in sheet1 or sheet2. Ex: In sheet 'Anderson Heating' There is no value in column F and that is showing as blank I want zero instead of blank. Same goes in sheet ‘Wilcox’

The macro looks for the number 10779463 in sheet2, but can not find it, so it does not update the "Anderson Heating" sheet anymore. It is not that the macro puts blank, rather the macro does not do anything. If you want a 0, you must start your column with 0 and the macro will update if the data exists.

 

[Abhishekghorpade]

The macro looks for the number 10779463 in sheet2, but can not find it, so it does not update the "Anderson Heating" sheet anymore. It is not that the macro puts blank, rather the macro does not do anything. If you want a 0, you must start your column with 0 and the macro will update if the data exists.

Hoo.. okay thank you so much for your time...

 

[DanteAmor]

Hoo.. okay thank you so much for your time...

Your welcome!