在特定的行上search值,将整个列复制到另一个表中

嘿家伙,即时通讯面临一个问题,应该只看到一个特定的行的值的VBA代码,从“行7列A”(例如),直到“行7最后一列该表具有”。

我试图实现的是:

excel上的一个button,它具有代码VBA来打开一个input对话框。 通过在input中给出的价值,我应该只search! 在特定的行上(只有1行)。 我开始从该行的列A开始在该行的值search,我需要循环,直到从该行的最后一个单元格。

如果代码findC7上的值,例如第7行C列,我需要将整个列复制到另一个工作表,然后再次查找从上次find的单元格开始的值。 因此,如果代码发现行7列G上包含的另一列,请再次执行该操作。

问题是,如果find多个列,那么我粘贴的表单应该是代码在列A上find的第一列,然后是代码在列B上find的第二列,依此类推。

到目前为止,我做了什么:

Sub bydepartment_Click() Dim value1 As Variant value1 = InputBox("Find the column by department.", "Report by department") If value1 = Empty Then Exit Sub End If Dim Found As Range, LastRow As Long Dim ColoanaToAdd As String Dim emptyOne As String Dim destination As Worksheet Dim emptyColumn As String Dim var As String Dim Coloana As String With Worksheets("DAT").Range("A1:QUY1") Sheets(value1).Cells.Clear Set Found = Sheets("DAT").Rows(5).Find(What:=value1, LookIn:=xlValues, LookAt:=xlWhole) If Not Found Is Nothing Then firstAddress = Found.Address Do LastRow = Cells(Rows.Count, Found.Column).End(xlUp).Row Select Case Found.Column Case 1 Coloana = "A" Case 2 Coloana = "B" Case 3 Coloana = "C" Case 4 Coloana = "D" Case 5 Coloana = "E" Case 6 Coloana = "F" Case 7 Coloana = "G" Case 8 Coloana = "H" Case 9 Coloana = "I" Case 10 Coloana = "J" Case 11 Coloana = "K" Case 13 Coloana = "L" Case 14 Coloana = "M" Case 15 Coloana = "N" Case 16 Coloana = "O" Case 17 Coloana = "P" End Select Set destination = Sheets(value1) emptyColumn = destination.Cells(5, destination.Columns.Count).End(xlToLeft).Column + 1 If emptyColumn > 1 Then emptyColumn = emptyColumn End If Select Case emptyColumn Case 1 var = "A" Case 2 var = "B" Case 3 var = "C" Case 4 var = "D" Case 5 var = "E" Case 6 var = "F" Case 7 var = "G" Case 8 var = "H" Case 9 var = "I" Case 10 var = "J" Case 11 var = "K" Case 13 var = "L" Case 14 var = "M" Case 15 var = "N" Case 16 var = "O" Case 17 var = "P" End Select emptyOne = var & 1 & ":" & var ColoanaToAdd = Coloana & 1 & ":" & Coloana Sheets(value1).Range(emptyOne & LastRow).Value = Sheets("DAT").Range(ColoanaToAdd & LastRow).Value MsgBox "Your report was created" Set Found = Sheets("DAT").Rows(5).FindNext(Found) Loop While Not Found Is Nothing And Found.Address <> firstAddress End If End With End Sub 

我硬编码与案例less列…我知道:(但我猜,我知道有一个更好的方式做…

在此先感谢你们!

这可能能够帮助你。 该代码在Sheet1的第7行中查找一些值( 快乐 )。 如果find,那么Sheet1中的整个列被复制到Sheet2

代码遍历Sheet1的 #7行中的所有单元格

 Sub OzZie() Dim sh1 As Worksheet, sh2 As Worksheet Dim K As Long, i As Long, nRow As Long Dim valuee1 As Variant Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") K = 1 nRow = 7 valuee1 = "happiness" For i = 1 To Columns.Count If sh1.Cells(nRow, i).Value = valuee1 Then sh1.Cells(nRow, i).EntireColumn.Copy sh2.Cells(1, K) K = K + 1 End If Next i End Sub 

试试这个代码@ozZie。 这是包括公式和区分大小写的问题

 Sub CopynPasteColumns() Dim sh1 As Worksheet, sh2 As Worksheet Dim K As Long, i As Long, nRow As Long Dim valuee1 As Variant Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") K = 1 nRow = 7 valuee1 = InputBox("Find the column by department.", "Report by department") For i = 1 To sh1.UsedRange.Columns.Count If LCase(sh1.Cells(nRow, i).Value) = LCase(valuee1) Then sh1.Cells(nRow, i).EntireColumn.Copy sh2.Cells(1, K).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False K = K + 1 End If Next i End Sub