Macro to copy data from one sheet to another

S

sdhasan

New Member
Joined
Oct 12, 2022
Messages
33
Office Version
  1. 365
Platform
  1. Windows
Hi guys,

Need your help with a macro.
I have a sheet called "Data" and it has data in the following columns (A:AB) with blank rows in between. Firstly I want the blank rows to be removed. Then I want the macro to copy the data in mentioned column (A:AB) which follows the following condition:
Column B <> "*5500*" (Column B has employee id eg: 5500124 or 2201876 { id starting from 5500 are for temp employees while id starting from any other number is for permanent employees}
to a new sheet from cell A2 which will be named on today's date like "16-Oct-22"
Once that is done, I want the macro to copy the data from the "Data" sheet that follows the following condition below in a new sheet named "Temp Drivers"
Column B = "*5500*"
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Sort by date Sort by votes
Try to attach a mini sheet
www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com
 
Upvote 0
bebo021999 said:
Try to attach a mini sheet
www.mrexcel.com

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...
www.mrexcel.com www.mrexcel.com
Click to expand...
1665994705890.png

This might help you
 
Upvote 0
bebo021999 said:
Nope. Image does not help much.
We need mini sheet to test directly.
Click to expand...
Sample.xlsx
ABCDEFGHIJKLMNOPQRSTUVWX
1SNEmp.#NameCategoryShift/ Time CodeMursaal IDMobileRelCar # TypeVehicle statusDay offEmp.#NameCategoryShift/ Time CodeMursaal IDMobileRelNationalityLocationPartnerDate Effective date
212015452AAAAAirport TaxiR 09:001247861234567InnovaPairSunday2016407AAAAAirport TaxiRR 21:001238909876543DIAYes4483744837
322016203BBBBAirport TaxiR 09:001247861234567InnovaPairWednesday2021012BBBBAirport TaxiRR 21:001238909876543DIAYes4483244802
432022974CCCCAirport TaxiR 09:001247861234567InnovaPairSunday2023000CCCCAirport TaxiRR 21:001238909876543DIAYes4483644837
542017848DDDDAirport TaxiH 04:001247861234567InnovaPairThursday2022966DDDDAirport TaxiHH 16:001238909876543DIAYes4484044841
652023159AAAAAirport TaxiR 09:001247861234567CamryPairSunday2018994AAAAAirport TaxiRR 21:001238909876543DIAYes4459144592
762020884BBBBAirport TaxiR 09:001247861234567InnovaPairMonday2017375BBBBAirport TaxiRR 21:001238909876543DIAYes4480844809
872015353CCCCAirport TaxiH 04:001247861234567InnovaPairTuesday2013258CCCCAirport TaxiHH 16:001238909876543DIAYes4483144832
985500456DDDDAirport TaxiR 09:001247861234567InnovaPairWednesday2019935DDDDAirport TaxiRR 21:001238909876543DIAYes4480344805
1092018194AAAAAirport TaxiD 02:001247861234567InnovaPairThursday2018170AAAAAirport TaxiDD 14:001238909876543DIAYes4480444805
11102016283BBBBAirport TaxiR 09:001247861234567InnovaPairTuesday2019296BBBBAirport TaxiRR 21:001238909876543DIAYes4483844839
12112019968CCCCAirport TaxiH 04:001247861234567InnovaPairSunday2019945CCCCAirport TaxiHH 16:001238909876543DIAYes4483644837
13
14122017224DDDDAirport TaxiH 04:001247861234567InnovaPairTuesday2017582DDDDAirport TaxiHH 16:001238909876543DIAYes4483144832
15132020118AAAAAirport TaxiH 04:001247861234567InnovaPairFriday2019017AAAAAirport TaxiHH 16:001238909876543DIAYes4484044841
16145500123BBBBAirport TaxiH 04:001247861234567InnovaPairTuesday2012074BBBBAirport TaxiHH 16:001238909876543DIAYes4483144832
17152011543CCCCAirport TaxiD 02:001247861234567InnovaPairFriday2020462CCCCAirport TaxiDD 14:001238909876543DIAYes4483344834
18162014807DDDDAirport TaxiD 02:001247861234567InnovaPairThursday2017653DDDDAirport TaxiDD 14:001238909876543DIAYes4474244743
19172018208AAAAAirport TaxiR 09:001247861234567InnovaPairThursday2021248AAAAAirport TaxiRR 21:001238909876543DIAYes4483344834
20
21182015934BBBBAirport TaxiL 06:001247861234567InnovaPairWednesday2014648BBBBAirport TaxiLL 18:001238909876543DIAYes4483944840
22192018814CCCCAirport TaxiD 02:001247861234567InnovaPairTuesday2018155CCCCAirport TaxiDD 14:001238909876543DIAYes4468444685
23202015389DDDDAirport TaxiH 04:001247861234567InnovaPairFriday2016815DDDDAirport TaxiHH 16:001238909876543DIAYes4483344834
Data
 
Upvote 0
Maybe help you...

VBA Code: 
Sub sdhasan()

    Dim x   As Long
    Dim y   As Long
    Dim wks As Worksheet
    
    Set wks = Sheets("Data")
    
    Application.ScreenUpdating = False
    
    With wks
        If .AutoFilterMode Then .AutoFilter = False
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        With .Cells(1, 1).Resize(x, y)
            .Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            .AutoFilter
            .AutoFilter field:=3, Criteria1:=">=5500000", Operator:=xlAnd, Criteria2:="<=5500999"
            .Offset(0).Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        End With
    End With
    
    With Sheets.Add
        .Name = Format(Date, "DD-MMM-YY")
        .Cells(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
        .UsedRange.Columns.AutoFit
    End With
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
    Set wks = Nothing
        
End Sub
 
Upvote 0
Flaiban said:
Maybe help you...

VBA Code: 
Sub sdhasan()

    Dim x   As Long
    Dim y   As Long
    Dim wks As Worksheet
   
    Set wks = Sheets("Data")
   
    Application.ScreenUpdating = False
   
    With wks
        If .AutoFilterMode Then .AutoFilter = False
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
       
        With .Cells(1, 1).Resize(x, y)
            .Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            .AutoFilter
            .AutoFilter field:=3, Criteria1:=">=5500000", Operator:=xlAnd, Criteria2:="<=5500999"
            .Offset(0).Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        End With
    End With
   
    With Sheets.Add
        .Name = Format(Date, "DD-MMM-YY")
        .Cells(1, 1).PasteSpecial xlPasteFormulasAndNumberFormats
        .UsedRange.Columns.AutoFit
    End With
   
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
   
    Set wks = Nothing
       
End Sub
Click to expand...
This code is only picking one row to copy as the filter that you've set has one value that falls under it. Can you change the filter criteria to Criteria = "*5500*" only
 
Upvote 0
You must log in or register to reply here.

Similar threads

awanak
  • Question
Random Allocation of Halls
Replies
0
Views
68
awanak
awanak
T
  • Question
Complex VBA to loop through each worksheet and extract text
Replies
3
Views
151
bobsan42
bobsan42
H
  • Question
How to create a macro to sort 2 non-adjacent columns?
Replies
1
Views
132
helpneeded2
H
T
  • Question
Copy values from one workbook to a another specific workbook based off a cell value
Replies
1
Views
405
thechad
T
Kaz09
  • Question
Copy rows of data from multiple worksheets to based on column equalling YES
Replies
0
Views
99
Kaz09
Kaz09

Forum statistics

Threads
1,214,517
Messages
6,119,984
Members
448,935
Latest member
ijat

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