PDA

View Full Version : [SOLVED] Find All, Copy & Paste to Next Blank in Sheet



Baiano42
08-07-2019, 08:43 AM
Good morning Excel wizs,

I'm trying to make a Macro that will search Worksheets(1) all headers in ("1:1") for ones containing 'Top' (where one column contain "Top", others contain "Green_Top", "Red_Top", etc.), to copy the entire column (Including header reference) and paste all instances to the next blank column in Worksheets(2)

I've been trying a number of different things, but haven't had any success with it so far. Here is one of the tests that I tried without success:


Dim RowNum As Long With Worksheets(1)
Set FoundCell = .Rows(1).Find("Top", , , , xlByColumns, xlNext)
RowNum = .Cells(.Rows.count, FoundCell.Column).End(xlUp).Row - 1 '-1 for header
End With

Worksheets(2).Range("C1").Resize(RowNum).Value = FoundCell.Offset(1).Resize(RowNum).Value

Baiano42
08-07-2019, 12:04 PM
Another thing that I was thinking of, but also haven't had success with, is getting it to hide all columns or doing an autofilter based on header value, but as mentioned above, I need it to be a relative value, as the 'X_Top' Changes, and the number of columns also changes. That complicates making an auto filter with a relative Field, I would need it to search through all the columns, which changes based on the project.

Baiano42
08-07-2019, 01:06 PM
So I'm able to make a little more progress, I'm able to get it to keep the cases of the specific headers I want ("A" & "Top"). However, I'm still having a problem with keeping the relative headers that change with different reports ("X" being the variable, and "_Top" being the constant e.g. X_Top).


Dim currentColumn As Integer Dim columnHeading As String


For currentColumn = ActiveSheet.UsedRange.Columns.count To 1 Step -1


columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value


'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "A", "Top"
'Do nothing
Case Else
'Delete if the cell doesn't contain "Homer"
If InStr(1, "Top") = 0 Then


ActiveSheet.Columns(currentColumn).Delete


End If
End Select
Next

jolivanes
08-07-2019, 07:24 PM
Try this.
Check references and change if and where required.

Sub Maybe()
Dim c As Range
For Each c In Range(Cells(1, 1), Cells(1, Cells(Columns.Count).End(xlToLeft).Column))
If c.Value Like "*Top*" Then c.EntireColumn.Copy Sheets("Sheet2").Cells(1, Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column + 1)
Next c
End Sub

Baiano42
08-08-2019, 06:40 AM
That works great! Thank you sir!

jolivanes
08-08-2019, 07:35 AM
Thank you for letting us know.
Good Luck