I am writing an Excel macro that copies information from 1 worksheet and pastes it to another. It has to search for a specific string of text to identify the right column to copy, and I'm using a switch statement to go through the various columns. It's going all the way to Z, so it's very long macro. I also need to use this for several search terms, which makes the macro too large.
Here is an excerpt of the code:
Select Case True
Case Range("A1").Value = "SearchTerm1"
Sheets("ExportSheet").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Template").Select
Range("L2").Select
ActiveSheet.Paste
Case Range("B1").Value = "SearchTerm1"
Sheets("ExportSheet").Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Template").Select
Range("L2").Select
ActiveSheet.Paste
Case Range("C1").Value = "SearchTerm1"
Sheets("ExportSheet").Select
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Template").Select
Range("L2").Select
ActiveSheet.Paste
Case Range("D1").Value = "SearchTerm1"
Sheets("ExportSheet").Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Template").Select
Range("L2").Select
ActiveSheet.Paste
Case Range("E1").Value = "SearchTerm1"
Sheets("ExportSheet").Select
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Template").Select
Range("L2").Select
ActiveSheet.Paste
It's going through the columns 1 by 1 to see if it contains a specific search term. If it does, it copies everything underneath it and pastes it starting in cell L2 on a separate worksheet. It's just a very long macro and I'm trying to simplify it. Would a For loop work?
With Sheets("ExportSheet")
Select Case True
Case .[A1].Value = "SearchTerm1"
.Range("A2:A" & Cells(.Rows.Count, "A").End(xlUp).Row).Copy Sheets("Template").[L2]
Case .[B1].Value = "SearchTerm1"
.Range("B2:B" & Cells(.Rows.Count, "B").End(xlUp).Row).Copy Sheets("Template").[L2]
Case .[C1].Value = "SearchTerm1"
.Range("C2:C" & Cells(.Rows.Count, "C").End(xlUp).Row).Copy Sheets("Template").[L2]
' and so on
End Select
End With
End Sub
Find method
Sub test2()
Dim x&, y&
On Error GoTo errorhandler
With Sheets("ExportSheet")
y = .Rows(1).Find("SearchTerm1").Column
x = .Cells(Rows.Count, y).End(xlUp).Row
.Range(.Cells(2, y), .Cells(x, y)).Copy Sheets("Template").[L2]
End With
Exit Sub
errorhandler:
MsgBox "There is no 'SearchTerm1' in 'ExportSheet'!"
End Sub
For each looping through the range of cells also optimal I think
Sub test3()
Dim Cl As Range
For Each Cl In Sheets("ExportSheet").[A1:E1]
If Cl.Value = "SearchTerm1" Then
Sheets("ExportSheet").Range(Cl.Offset(1, 0).Address(0, 0), _
Cells(Rows.Count, Cl.Column).End(xlUp).Address(0, 0)).Copy _
Sheets("Template").[L2]
Exit For
End If
Next
End Sub
As I understand it, you are actually looking for the header from which you need to copy the data. If that is so:
With Sheets("ExportSheet")
Dim r As Range: Set r = .Range("1:1").Find("SearchTerm1")
If Not r Is Nothing Then
.Range(r.Offset(1, 0), r.Offset(1, 0).End(xlDown)).Copy _
Sheets("Template").Range("L2")
End If
End With
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With