Vba 在特定行上搜索值，将整个列复制到另一个工作表

嗨，伙计们，我面临一个vba代码的问题，它应该只在特定的行上查找一个值，从“第7行a列”（例如）开始，直到“第7行工作表的最后一列”

我努力实现的目标：

excel上的按钮，其代码为VBA，用于打开输入对话框。 根据输入中给定的值，我应该只搜索！在特定行上（仅1行）。 我从该行的A列开始按该行的值搜索，我需要循环到该行的最后一个单元格

如果代码在C7上找到值，例如，第7行第C列，我需要将整个列复制到另一个工作表中，并再次开始查找从上次找到的单元格开始的值。因此，如果代码在第7行G列中找到另一列，请再次执行该操作

问题是，如果找到多个列，在我粘贴的工作表上，em应该是代码在A列找到的第一列，然后是代码在B列找到的第二列。。。等等

到目前为止我所做的：

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

子部门\单击（）
尺寸值1作为变量
value1=输入框（“按部门查找列”，“按部门报告”）
如果value1=空，则
出口接头
如果结束
发现变暗为范围，最后一行为长度
以字符串形式加载
把空的东西当作线
将目标设置为工作表
将emptyColumn设置为字符串
作为字符串的Dim var
朦胧的科洛纳丝线
带工作表（“DAT”）。范围（“A1:QUY1”）
表（值1）。单元格。清除
Set Found=Sheets（“DAT”）.行（5）.查找（内容：=value1，查找：=xlValues，查找：=xltotal）
如果找不到，那就什么都没有了
firstAddress=找到。地址
做
LastRow=单元格（Rows.Count，Found.Column）.End（xlUp）.Row
选择Case Found.Column
案例1
科罗纳=“A”
案例2
Coloana=“B”
案例3
Coloana=“C”
案例4
Coloana=“D”
案例5
科罗纳=“E”
案例6
Coloana=“F”
案例7
Coloana=“G”
案例8
Coloana=“H”
案例9
Coloana=“I”
案例10
Coloana=“J”
案例11
Coloana=“K”
案例13
Coloana=“L”
案例14
Coloana=“M”
案例15
Coloana=“N”
案例16
Coloana=“O”
案例17
Coloana=“P”
结束选择
设置目的地=图纸（值1）
emptyColumn=destination.Cells（5，destination.Columns.Count）。End（xlToLeft）。Column+1
如果emptyColumn>1，则
emptyColumn=emptyColumn
如果结束
选择Case emptyColumn
案例1
var=“A”
案例2
var=“B”
案例3
var=“C”
案例4
var=“D”
案例5
var=“E”
案例6
var=“F”
案例7
var=“G”
案例8
var=“H”
案例9
var=“I”
案例10
var=“J”
案例11
var=“K”
案例13
var=“L”
案例14
var=“M”
案例15
var=“N”
案例16
var=“O”
案例17
var=“P”
结束选择
emptyOne=var&1&“：”&var
coloanaoadd=Coloana&1&“：”&Coloana
图纸（值1）.范围（清空一行和最后一行）.值=图纸（“DAT”）.范围（克隆加载和最后一行）.值
MsgBox“您的报告已创建”
集合已找到=工作表（“DAT”）。行（5）。FindNext（已找到）
未找到时的循环为Nothing并已找到。Address firstAddress
如果结束
以
端接头

我硬编码了几个列的案例。。。我知道：（但我想，我知道有更好的方法

---

提前感谢大家！

这可能会对您有所帮助。代码在Sheet1的第7行中查找一些值（幸福）。如果找到，则Sheet1中的整列将复制到Sheet2

代码在Sheet1第7行的所有单元格中循环

---

试试这个代码@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

---

+1给你@Gary的学生！效果很好。在接受答案之前有一个问题，我如何避免输入区分大小写？我的意思是，我在第7行有值“DAN”和“DAN”，“DAN”…我如何生成代码，生成所有这些列，而不管输入值是否区分大小写？“DAN”，“DAN”…此外，它没有正确复制公式。例如，对于我正在查看的工作表，它为“='C:\Users\OzZie\Desktop\MMG\SRBC 1\QBC-R[QBC-1.xlsx]Feuil3'！C3”，并粘贴“=Sheet2！A3”@OzZie以使测试不区分大小写，如果sh1.Cells（nRow，i）。Value=value1然后将替换为

如果UCase（sh1.Cells（nRow，i）.Value）=值1，然后

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