How to copy columns based on specific criteria.

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
182
Office Version
  1. 365
Platform
  1. Windows
I am getting ready to copy this code for another process but now I need to set it up to either use the different criteria in a column or to some how only copy the data until the blank three rows. The worksheet as for an example has 10 rows of information with header then 3 blank rows then a new set of data below without headers but is the same as the data above the 3 blank rows with the only difference in the column criteria.

The first set of data is by rate code MUSL the rest below is MUSOPSS. Not sure how to make this column M as the criteria to copy only the columns listed below for MUSL. Then I need to copy the same columns listed below for the MUSOPSS and past to a different worksheet. Could you give me some advice where to go from here?

1605110969323.png


[/CODE] Sub Mode2Delivery()
' Copy Selected columns to script ADD & END Operand Mode 2 Delivery tab
VBA Code:
Sub Mode2Delivery()
' Copy Selected columns to script ADD & END Operand Mode 2 Delivery tab
Dim LastRow As Long
LastRow = Sheets("Installation wkg").Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False
With Sheets("ADD & END Operand Mode2 Delivry")
Sheets("Installation wkg").Range("H2:H" & LastRow).Copy Destination:=.Range("B3")
Sheets("Installation wkg").Range("I2:I" & LastRow).Copy Destination:=.Range("C3")
Sheets("Installation wkg").Range("K2:K" & LastRow).Copy Destination:=.Range("D3")
Sheets("Installation wkg").Range("W2:W" & LastRow).Copy Destination:=.Range("I3")
Sheets("Installation wkg").Range("AA2:AA" & LastRow).Copy Destination:=.Range("M3")
Sheets("Installation wkg").Range("X2:X" & LastRow).Copy Destination:=.Range("J3")

.Columns("J:J").NumberFormat = "mm/dd/yyyy"
.Columns("E:E").NumberFormat = "mm/dd/yyyy"
.Range("A2").AutoFill .Range("A2:A" & LastRow + 1)
.Range("F2").AutoFill .Range("F2:F" & LastRow + 1)

End With
End Sub
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,751
Office Version
  1. 2013
Platform
  1. Windows
It is not clear to me what you want to copy, where you want to copy it from and where you want to paste it, but it seems to me that you could filter column M using the two criteria shown in the image and then just copy from the results.
 

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
182
Office Version
  1. 365
Platform
  1. Windows
It is not clear to me what you want to copy, where you want to copy it from and where you want to paste it, but it seems to me that you could filter column M using the two criteria shown in the image and then just copy from the results.
This is a template for the end user to push buttons. The worksheet with all the data is sorted and separated by 3 blank rows. (WorkSh - Installation wkg) the user currently copies and pastes to two other worksheets, one for the top half of the information (to sheet 5) and one for the second have (below the 3 blank rows) Sheet 6...does this help to explain. I want the VBA to copy and paste all the criteria so there is no end user manual steps.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,751
Office Version
  1. 2013
Platform
  1. Windows
Still not sure I fully understand, but you can try this.

VBA Code:
Sub t()
Dim sh As Worksheet
Set sh = Sheets("Installation Wkg") 'Edit sheet name
sh.UsedRange.AutoFilter 13, "MUSL"
sh.UsedRange.Offset(1).Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp)(2)
sh.AutoFilterMode = False
sh.UsedRange.AutoFilter 13, "MUSOPSS"
sh.UsedRange.Offset(1).Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp)(2)
sh.AutoFilterMode = False
End Sub
 

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
182
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Still not sure I fully understand, but you can try this.

VBA Code:
Sub t()
Dim sh As Worksheet
Set sh = Sheets("Installation Wkg") 'Edit sheet name
sh.UsedRange.AutoFilter 13, "MUSL"
sh.UsedRange.Offset(1).Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp)(2)
sh.AutoFilterMode = False
sh.UsedRange.AutoFilter 13, "MUSOPSS"
sh.UsedRange.Offset(1).Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp)(2)
sh.AutoFilterMode = False
End Sub
I put this at the top of the code but it did not work should it go in a different order?
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,751
Office Version
  1. 2013
Platform
  1. Windows
It was a stand-alone example of how to filter on column M, based solely on what I could derive from the OP. Since I cannot see your worksheet and do not fully comprehend the issue. it is about the best I can offer. I understand that your data is separated by empty rows, but that should make no difference in how it filters. The code I posted worked in a mock up sheet where the data was separated by empty rows and grouped by the values in column M. I cannot analyze "Did not work" as a symptom. I would need to know if there was an error message and what the message said and which line of code was highlighted when the debug button was clicked. If there was no error message, then what if anything did the code produce?
 

fvisions

Board Regular
Joined
Jul 29, 2008
Messages
182
Office Version
  1. 365
Platform
  1. Windows
I mess around with it a bit and got it to work. Thank your for your help.

VBA Code:
Sub Mode2Delivery()
'
' Copy Selected columns to script ADD & END Operand Mode 2 Delivery tab

VBA Code:
Dim sh As Worksheet
Set sh = Sheets("Installation wkg")
Worksheets("Installation wkg").Range("A1").AutoFilter Field:=13, Criteria1:="MUSL"

Dim LastRow As Long
LastRow = Sheets("Installation wkg").Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False

With Sheets("ADD & END Operand Mode2 Delivry")
Sheets("Installation wkg").Range("H2:H" & LastRow).Copy Destination:=.Range("B3")
Sheets("Installation wkg").Range("I2:I" & LastRow).Copy Destination:=.Range("C3")
Sheets("Installation wkg").Range("K2:K" & LastRow).Copy Destination:=.Range("D3")
Sheets("Installation wkg").Range("W2:W" & LastRow).Copy Destination:=.Range("I3")
Sheets("Installation wkg").Range("AA2:AA" & LastRow).Copy Destination:=.Range("M3")
Sheets("Installation wkg").Range("X2:X" & LastRow).Copy Destination:=.Range("J3")

.Columns("J:J").NumberFormat = "mm/dd/yyyy"
.Columns("E:E").NumberFormat = "mm/dd/yyyy"
.Range("A2").AutoFill .Range("A2:A" & LastRow + 1)
.Range("F2").AutoFill .Range("F2:F" & LastRow + 1)

Worksheets("Installation wkg").AutoFilterMode = False
End With
End Sub
 
Solution

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,751
Office Version
  1. 2013
Platform
  1. Windows
You're welcome,
regards, JLG
 

Watch MrExcel Video

Forum statistics

Threads
1,118,800
Messages
5,574,399
Members
412,589
Latest member
Velly
Top