Match 1 cell of record and Transpose 2 cells to another sheet.

[Strabo]

Excel 2007

In Sheet1 I have data (records) beginning at row 2 thru whatever (say row
318). The number of records can vary. Each record is from column a thru y. I
would like to match column i to either LSTE, LSHG, or Tlibor. When there is a
match take data in column b and k and transpose it to Sheet2 beginning at
cell a1. Column b is text and k is a date. I suppose there could be 318
results but more likely 20 to 30. First match would be data from b in a1,
data from k in a2. Second match would be data from b in b1, data fromk in b2,
etc.

After writing this maybe it would be better to sort on the three items for
column i and copy past (transposing). I just do not know how to do it.

Thank you for looking at my question.

 

[NoodNutt]

G'day

I use this to extract certain data from one sheet into multiple.

You will have to modify it to suit your data criteria.

Sub Split_Data()

Dim SourceSheet As Worksheet
Dim DestinationSheet As Worksheet
Dim rng As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Start of NSW

Sheets("NSW").Select

Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("NSW")

SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=SYD"

SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With

Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'End of NSW

'Start of QLD

Sheets("Qld").Select

Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("Qld")

SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=BNE"

SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With

Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'End of QLD

'Start of SA

Sheets("SA").Select

Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("SA")

SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=ADL"

SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With

Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'End of SA

'Start of Vic

Sheets("Vic").Select

Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("Vic")

SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=MEL"

SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With

Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'End of Vic

'Start of WA

Sheets("WA").Select

Set SourceSheet = Sheets("Data")
Set rng = SourceSheet.Range("A8:O" & Rows.Count)
Set DestinationSheet = Sheets("WA")

SourceSheet.AutoFilterMode = False
rng.AutoFilter Field:=1, Criteria1:="=PER"

SourceSheet.AutoFilter.Range.Copy
With DestinationSheet.Range("A5")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Select
End With

SourceSheet.AutoFilterMode = False

Range("A4:O50").Select
Selection.Sort Key1:=Range("A4:A50"), Order1:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'End of WA

With Application
CalcMode = .Calculation
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

HTH
Mark.

 

[Strabo]

NoodNutt:

Thank you for your response.
This helps but I was hoping for a loop thru the records and upon match
select appropriate cells and copy this data to other sheet transposed.