vba to copy from another workbook based on criteria

T

TRIP82

New Member
Joined
Jun 11, 2016
Messages
28
Office Version
  1. 2013
I need to copy data from table below in workbook data.xlsb based on criteria TEAM and EPOCA) and paste it in another workbook (H2H.xlsm). I'm trying this vba code, to copy the data if matches criteria from colomn B and D, but only copy the first one (then need to repeat the same to copy from colomn B and E)
I find the code online and try to adpat for my case but without sucess.
Thanks in advance

criteria:
EPOCA = 2021-2022
TEAM = Dortmund

VBA Code: 
Option Explicit

Sub getData()

Dim LastRow As Integer, i As Integer, erow As Integer
Dim TEAM As String
Dim EPOCA As String

TEAM = Range("B2").Value
EPOCA = Range("A2").Value

Application.Goto Workbooks("DATA.xlsb").Sheets("DATABASE").CELLS(1, 1)

LastRow = Workbooks("DATA.xlsB").Sheets("DATABASE").Range("A" & Rows.COUNT).End(xlUp).ROW

For i = 2 To LastRow

If CELLS(i, 2) = EPOCA And CELLS(i, 4) = TEAM Then
Range(CELLS(i, 1), CELLS(i, 37)).Select
Selection.COPY

Application.Goto Workbooks("H2H.xlsm").Sheets("SHEET1").CELLS(1, 1)
Worksheets("Sheet1").Select
erow = ActiveSheet.CELLS(Rows.COUNT, 1).End(xlUp).Offset(1, 0).ROW

ActiveSheet.CELLS(erow, 1).Select
ActiveSheet.Paste
'ActiveWorkbook.Save
'ActiveWorkbook.Close
Application.CutCopyMode = False
End If

Next i
End Sub

CODEPOCADATAcasaforaCFHT CHT F
D12021-202222-08-2021Bayern MunichFC Koln3200
D12021-202222-08-2021HoffenheimUnion Berlin2221
D12021-202227-08-2021DortmundHoffenheim3200
D12021-202228-08-2021Bayern MunichHertha Berlin5020
D12021-202228-08-2021FC AugsburgLeverkusen1412
D12021-202228-08-2021StuttgartFreiburg2323
D12021-202228-08-2021FSV MainzGreuther Furth3020
D12021-202228-08-2021FC KolnBochum2100
D12021-202228-08-2021BielefeldE. Frankfurt1101
D12021-202229-08-2021Union BerlinMonchengladbach2120
D12021-202229-08-2021WolfsburgRB Leipzig1000
D12021-202211-09-2021RB LeipzigBayern Munich1401
D12021-202211-09-2021LeverkusenDortmund3421
D12021-202211-09-2021FreiburgFC Koln1101
D12021-202211-09-2021HoffenheimFSV Mainz0201
D12021-202211-09-2021Union BerlinFC Augsburg0000
D12021-202211-09-2021Greuther FurthWolfsburg0201
D12021-202212-09-2021MonchengladbachBielefeld3111
D12021-202212-09-2021E. FrankfurtStuttgart1100
D12021-202212-09-2021BochumHertha Berlin1302
D12021-202217-09-2021Hertha BerlinGreuther Furth2100
D12021-202218-09-2021Bayern MunichBochum7040
D12021-202218-09-2021FSV MainzFreiburg0000
D12021-202218-09-2021BielefeldHoffenheim0000
D12021-202218-09-2021FC KolnRB Leipzig1100
D12021-202218-09-2021FC AugsburgMonchengladbach1000
D12021-202219-09-2021DortmundUnion Berlin4220
D12021-202219-09-2021StuttgartLeverkusen1312
D12021-202219-09-2021WolfsburgE. Frankfurt1101
D12021-202224-09-2021Greuther FurthBayern Munich1302
D12021-202225-09-2021MonchengladbachDortmund1010
D12021-202225-09-2021LeverkusenFSV Mainz1000
D12021-202225-09-2021HoffenheimWolfsburg3111
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
Assuming your code is working try changing your if statement to this:-
VBA Code: 
If CELLS(i, 2) = EPOCA And (CELLS(i, 4) = TEAM Or CELLS(i, 5) = TEAM) Then
 
Upvote 0
thanks for the input, the code is working, but only gets the first instance of criteria. That is the problem, and I dont know how to solve it :/

H2H.xlsm
ABCDEFGHI
1EPOCACASA
22021-2022Dortmund
3D12021-202214-08-2021DortmundE. Frankfurt5231
4
5
Sheet1
 
Upvote 0
I will have a look this afternoon (my time). How many rows of data are in your "Database" ?
 
Upvote 0
Give this a try. If it is too slow we can make it faster but it will also make it harder for you follow:

I am pretty sure the reason yours was only copying the first record was that the first time you looked up the range(CELLS, the Data workbook was the active workbook, you then did a goto making H2H the activeworkbook and never switched back, so you next read range(CELLS was from H2H instead of the Data workbook.

You want to avoid "activate" including goto and select anyway since they are very slow, so see if this works for you.

VBA Code: 
Sub getData_Mod()

    Dim lrData As Integer, i As Integer, lrH2H As Integer
    Dim TEAM As String
    Dim EPOCA As String
    Dim wbData As Workbook, wbH2H As Workbook
    Dim shtData As Worksheet, shtH2H As Worksheet
    Dim rngDataRow As Range
    
    Set wbH2H = Workbooks("H2H.xlsm")
    Set shtH2H = wbH2H.Worksheets("SHEET1")

    
    Set wbData = Workbooks("DATA.xlsb")
    Set shtData = wbH2H.Worksheets("DATABASE")
    
    TEAM = shtH2H.Range("B2").Value
    EPOCA = shtH2H.Range("A2").Value
    
    lrData = shtData.Range("A" & shtData.Rows.Count).End(xlUp).Row
    lrH2H = shtH2H.Cells(shtH2H.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lrData
        
        With shtData
        
            If .Cells(i, 2) = EPOCA And _
                (.Cells(i, 4) = TEAM Or .Cells(i, 5) = TEAM) Then                    
                
                Set rngDataRow = .Range(.Cells(i, 1), .Cells(i, 37))

                lrH2H = lrH2H + 1
                rngDataRow.Copy Destination:=shtH2H.Cells(lrH2H, 1)
                
            End If
        
        End With
        
    Next i
    
    'ActiveWorkbook.Save
    'ActiveWorkbook.Close
    Application.CutCopyMode = False
End Sub
 
Upvote 0
Solution
Thanks Alex, works great! I'm newbie with vba, but I understand your explanation :)
In this line of code It's possible to past just values instead of format and values?

rngDataRow.Copy Destination:=shtH2H.Cells(lrH2H, 1)

Thanks
 
Upvote 0
TRIP82 said:
In this line of code It's possible to past just values instead of format and values?

rngDataRow.Copy Destination:=shtH2H.Cells(lrH2H, 1)

Thanks
Click to expand...
Sure just replace that line with these 2 lines:
(xlPasteValues is more commonly used but I prefer using the with number format option. This keeps dates looking like dates)

VBA Code: 
                rngDataRow.Copy
                shtH2H.Cells(lrH2H, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' Or xlPasteValues

Also you may want to autofit your columns at the end of the code.
(after Next i and before your save workbook)
VBA Code: 
shtH2H.usedrange.columns.autofit
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy paste columns based on matching header into another workbook
Replies
5
Views
112
mumps
mumps
youbitto
  • Question Question
Copying from Filtered range
Replies
1
Views
95
Peter_SSs
Peter_SSs
P
  • Question Question
Copy a worksheet from one workbook to another workbook based on conditional statements
Replies
5
Views
349
HighAndWilder
H
F
  • Solved
VBA split sheet based on a repeating value
Replies
4
Views
447
fogarasia
F
Guna13
  • Question Question
How to Efficient way for create Multiple Workbooks
Replies
1
Views
384
Guna13
Guna13

Forum statistics

Threads
1,223,229
Messages
6,170,881
Members
452,364
Latest member
springate

Share this page

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
Back
Top