Transfer data

[jimpatel1993]

Hi

Thanks for looking at my post.
I have attached my query in the word document.
Really appreciate your time and help.
It will be great if some one could help please.

Thanks again
Jim

[HansV]

Code: Select all

Sub TransferData()
    Dim wbs As Workbook
    Dim wbt As Workbook
    Dim wss As Worksheet
    Dim wst As Worksheet
    Dim s As Long
    Dim m As Long
    Dim t As Long
    Application.ScreenUpdating = False
    Set wbs = ActiveWorkbook ' Source
    Set wss = wbs.Worksheets(1)
    Set wbt = Workbooks("Destination.xlsx") ' Destination
    Set wst = wbt.Worksheets(1)
    t = 1
    m = wss.Range("A" & wss.Rows.Count).End(xlUp).Row
    For s = 2 To m
        If wss.Range("C" & s).Value = "Class 2" Then
            wst.Range("Q" & t).Resize(1, 12).Value = wss.Range("D" & s).Resize(1, 12).Value
        Else
            t = t + 1
            wst.Range("B" & t).Resize(1, 14).Value = wss.Range("B" & s).Resize(1, 14).Value
        End If
    Next s
    Application.ScreenUpdating = True
End Sub

[jimpatel1993]

Thanks a lot for your reply and really really appreciate it.
First of all really thank you for your time and effort :)
I just have one issue when the destination id is not in sequence with source id the data is not transferring according to the id number. Believe it is transferring according from row to row. I have highlighted in the destination workbook. Row 2 and 12 i have swapped to id to check correct data is transferring from source to destination , but unfortunately it does not.

Any idea about this please.
This help means lot :)

Thanks again

[HansV]

Then you should ensure that the IDs are in the same order.

[jimpatel1993]

Thanks for your reply Hans.
Is there any way of doing filter with matching id?
Because I have 100s of data sometimes more than one I'd repeat that's why.
Thanks again

[HansV]

Since there can be more than one row with the same ID, that would be difficult.
An alternative would be to simply populate the entire destination sheet instead of relying on already present IDs.

[jimpatel1993]

That will be ideal.
Any idea of how to do that please?
Do I need to modify outstanding code?
Sorry as I am not good in vba
Any help will be appreciated

Thanks again

[HansV]

The destination sheet only needs to contain the headers in row 1. See the attached workbooks.

Source.xlsm

Destination.xlsx

[jimpatel1993]

That's fantastic Hans. You are genius... Much appreciated your work.
One last question is what if I want to transfer only to visible rows please?

[HansV]

Like this:

Code: Select all

Sub Button1_Click()
    Dim wbs As Workbook
    Dim wbt As Workbook
    Dim wss As Worksheet
    Dim wst As Worksheet
    Dim s As Long
    Dim m As Long
    Dim t As Long
    Dim t2 As Long
    Application.ScreenUpdating = False
    Set wbs = ActiveWorkbook ' Source
    Set wss = wbs.Worksheets(1)
    Set wbt = Workbooks("Destination.xlsx") ' Destination
    Set wst = wbt.Worksheets(1)
    t = 1
    m = wss.Range("A" & wss.Rows.Count).End(xlUp).Row
    For s = 2 To m
        If wss.Range("A" & s).EntireRow.Hidden = False Then
            If wss.Range("C" & s).Value = "Class 2" Then
                t2 = wst.Range("A:A").Find(What:=wss.Range("A" & s).Value, LookAt:=xlWhole).Row
                wst.Range("P" & t2).Resize(1, 13).Value = wss.Range("C" & s).Resize(1, 13).Value
            Else
                t = t + 1
                wst.Range("A" & t).Resize(1, 15).Value = wss.Range("A" & s).Resize(1, 14).Value
            End If
        End If
    Next s
    Application.ScreenUpdating = True
End Sub

[jimpatel1993]

Unbelievable....
Great works hans
Thanks a lot for your time and input.
Much appreciated

[jimpatel1993]

Sorry Hans just one last question as I have not explained you properly. Really sorry.
What if I want to transfer only to visible cells in the destination workbook please?
Really sorry.
Just point me where I need to change in the code that should be fine.
Really apologies

[HansV]

Do you mean that there are hidden columns?

[jimpatel1993]

What I mean is I wanted to hide some rows in destination workbook. So when I wanted to transfer data from source workbook to destination I don't want to transfer to hidden row please.
Example row 10 to 20 is hidden in destination workbook. When I transfer from source workbook to destination, row 11 of source workbook will be from row 21 in the destination.

Thanks a lot

[HansV]

Code: Select all

Sub Button1_Click()
    Dim wbs As Workbook
    Dim wbt As Workbook
    Dim wss As Worksheet
    Dim wst As Worksheet
    Dim s As Long
    Dim m As Long
    Dim t As Long
    Dim t2 As Long
    Application.ScreenUpdating = False
    Set wbs = ActiveWorkbook ' Source
    Set wss = wbs.Worksheets(1)
    Set wbt = Workbooks("Destination.xlsx") ' Destination
    Set wst = wbt.Worksheets(1)
    t = 1
    m = wss.Range("A" & wss.Rows.Count).End(xlUp).Row
    For s = 2 To m
        If wss.Range("A" & s).EntireRow.Hidden = False Then
            If wss.Range("C" & s).Value = "Class 2" Then
                t2 = wst.Range("A:A").Find(What:=wss.Range("A" & s).Value, LookAt:=xlWhole).Row
                wst.Range("P" & t2).Resize(1, 13).Value = wss.Range("C" & s).Resize(1, 13).Value
            Else
                Do
                    t = t + 1
                Loop Until wst.Range("A" & t).EntireRow.Hidden = False
                wst.Range("A" & t).Resize(1, 15).Value = wss.Range("A" & s).Resize(1, 14).Value
            End If
        End If
    Next s
    Application.ScreenUpdating = True
End Sub

[jimpatel1993]

Fantastic Hans
Really thanks for your kind help

Thanks again