Results 1 to 8 of 8

Thread: How to copy values from one workbook sheet to another, based on criterias ?

  1. #1
    New Member
    Join Date
    Sep 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default How to copy values from one workbook sheet to another, based on criterias ?



    I have the Code that copies the values and gives me the values but not the one that i Need. I feel that I am Close but something is missing. The Code copies the whole worksheet of the workbook and i Need the values that meet the criterias.
    I have this main workbookand i want to take Information from different workbooks which have the same Format, for example this and I want, in the main workbook, to paste the values in some range based on the criterias in the first three columns ("SSL";"Baureihe";"Produktionsjahr")

    This is the Code that i have done till now


    Code:
    
        Sub Transfer ()
    
        Dim SSl As String
        Dim Baureihe As String
        Dim Produktionsjahr As String
        Dim fileName As String
        Dim Tfile As Workbook
        Dim shData As Worksheet, shOutput As Worksheet
        Dim rg As Range, ra As Range
        Dim i As Long, row As Long, j As Long
        Set shData = ThisWorkbook.Worksheets("Transponieren")
    
        filename = Application.getOpenFilename("Excel file (*.xlsm),*.xlsm", , "Select File")
    
        If filename = Empty then
         Exit Sub
        End If
    
        Set Tfile = Application.Workbooks.Open(filename)
        Set shOutput = Tfile.Worksheets("Transponieren")
        Set rg = shData.Range("A1").CurrentRegion
        Set ra = shOutput.range("A1").CurrentRegion
    
    
        row = 2
    
        For i = 2 To rg.Rows.Count
    
                SSL = Sheets("Transponieren").Cells(i, 1).Value
                Baureihe = Sheets("Transponieren").Cells (i , 2).Value
                Produktionsjahr = Sheets("Transponieren") .Cells(i, 3).Value
    
            For j = 2 To ra.Rows.Count
    
                If ra.Cells(j, 1).Value = SSL And _
                ra.Cells(j, 2).Value = Baureihe And _
                ra.Cells(j, 3).Value = Produktionsjahr Then
    
       Tfile.Sheets("Transponieren").Range("A" & i & ":E" & i).Copy _ 
      Destination:=ThisWorkbook.Sheets("Transponieren").Range("K" & j & ":O" & j)
    
         row = row + 1
         Application.CutCopyMode = False
    
                End if
            Next j
        Next i
    
        End Sub
    I am new at vba Excel, i tried various way but i can't seem to see why this Code doesn't copy only the values that i Need but it copies the whole sheet and it pastes in the given range. Please help !Thanks in Advance.




  2. #2
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    6,920
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    15 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    Try the following macro, it is longer than yours, but it will certainly be faster.

    Code:
    Sub transfer()
      Dim fileName As Variant, a() As Variant, b() As Variant, c As Variant, i As Long, j As Long
      Dim sh1 As Worksheet, wb2 As Workbook, sh2 As Worksheet
      '
      Application.ScreenUpdating = False
      Set sh1 = Sheets("Transponieren")
      fileName = Application.GetOpenFilename("Excel file (*.xlsm),*.xlsm", , "Select File")
      If fileName = False Then Exit Sub
      Set wb2 = Application.Workbooks.Open(fileName)
      Set sh2 = wb2.Sheets("Transponieren")
      '
      a = sh1.Range("A2:C" & sh1.Range("A" & Rows.Count).End(xlUp).row)
      b = sh2.Range("A2:E" & sh2.Range("A" & Rows.Count).End(xlUp).row)
      ReDim c(1 To UBound(a), 1 To 5)
      For i = 1 To UBound(a)
        For j = 1 To UBound(b)
          If a(i, 1) = b(j, 1) And a(i, 2) = b(j, 2) And a(i, 3) = b(j, 3) Then
            c(i, 1) = b(j, 1)
            c(i, 2) = b(j, 2)
            c(i, 3) = b(j, 3)
            c(i, 4) = b(j, 4)
            c(i, 5) = b(j, 5)
            Exit For
          End If
        Next
      Next
      wb2.Close False
      sh1.Range("K2").Resize(UBound(a), 5).Value = c
    End Sub
    Last edited by DanteAmor; Oct 18th, 2019 at 04:28 PM.
    Regards Dante Amor

  3. #3
    New Member
    Join Date
    Sep 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    Hi Dante Amor,

    It worked perfectly fine, i just have a quick question, How can i make the
    Code:
    c(i, 4) = b(j ,4)
    start on the range K2. I tried removing the rest of the Code c-s and moving the range Forward , instead of K2 to do it on D2 but then it erases the rest of the datas in the current sheet.

    Thankfully,
    Elvis

  4. #4
    New Member
    Join Date
    Sep 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    Never mind, i fixed it. Thanks a lot tho.

    Bests

  5. #5
    New Member
    Join Date
    Sep 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    I just Need one more Thing, it works the Code perfectly fine now. I just Need when i copy the datas ene then i paste them i Need to create a new column in E and paste them there. So each time when i paste the data it should be pasted in that form.
    Thanks again.

  6. #6
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    6,920
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    15 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    Hi @Elvis16, Try the following, I hope it helps.

    Code:
    Sub transfer()
      Dim fileName As Variant, a() As Variant, b() As Variant, c As Variant, i As Long, j As Long
      Dim sh1 As Worksheet, wb2 As Workbook, sh2 As Worksheet
      '
      Application.ScreenUpdating = False
      Set sh1 = Sheets("Transponieren")
      fileName = Application.GetOpenFilename("Excel file (*.xlsm),*.xlsm", , "Select File")
      If fileName = False Then Exit Sub
      Set wb2 = Application.Workbooks.Open(fileName)
      Set sh2 = wb2.Sheets("Transponieren")
      '
      a = sh1.Range("A2:C" & sh1.Range("A" & Rows.Count).End(xlUp).row)
      b = sh2.Range("A2:E" & sh2.Range("A" & Rows.Count).End(xlUp).row)
      ReDim c(1 To UBound(a), 1 To 5)
      For i = 1 To UBound(a)
        For j = 1 To UBound(b)
          If a(i, 1) = b(j, 1) And a(i, 2) = b(j, 2) And a(i, 3) = b(j, 3) Then
            c(i, 1) = b(j, 1)
            c(i, 2) = b(j, 2)
            c(i, 3) = b(j, 3)
            c(i, 4) = b(j, 4)
            c(i, 5) = b(j, 5)
            Exit For
          End If
        Next
      Next
      wb2.Close False
      sh1.Columns("E:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      sh1.Range("E2").Resize(UBound(a), 5).Value = c
    End Sub
    Regards Dante Amor

  7. #7
    New Member
    Join Date
    Sep 2019
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    Thanks a lot, it really helped.
    Best Regards,

  8. #8
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    6,920
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    15 Thread(s)

    Default Re: How to copy values from one workbook sheet to another, based on criterias ?

    Im glad to help you, thanks for the feedback.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •