Excel宏可以从一个工作表中搜索第1行中的某些文本，复制文本下面的列，然后粘贴到另一个工作表上。
Excel宏可以从一个工作表中搜索第1行中的某些文本，复制文本下面的列，然后粘贴到另一个工作表上。
提问于 2016-07-01 14:52:42
我对Excel宏非常陌生，需要一些帮助才能完成以下任务。
我在同一个工作簿中有两个工作表；一个是可以编辑的主工作表，另一个是从主工作表中提取某些列。由于主表中可能插入或删除了列，所以我的方法是输入特定的标题，然后将其提取到工作表2 (最初的空白页)，在第1页(主表)中查找/匹配这些文本/列标题；然后，复制该匹配列标题下的整个列并将其粘贴到第2页。
我有下面的代码，但是仍然会弹出错误。由于我对宏语法不太熟悉，所以我不太确定这种方法是否适用。我非常感谢任何帮助、评论或建议。提前谢谢。
Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim r As Long
For i = 1 To 30
For j = 1 to 30
If Sheets(2).Cells(1, j).Value = Sheets(7).Cells(1, i).Value Then
For r = 2 To 1000
Sheets(2).Cells(r, j).Copy
Sheets(7).Cells(r, i).PasteSpecial Paste:=xlPasteFormats
Sheets(7).Cells(r, i).PasteSpecial Paste:=xlPasteValue
Next r
End If
Next j
Next i
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2016-07-01 15:18:33
最好使用Range对象的Range方法来查找范围内的值
所以您可能需要使用以下代码
Option Explicit
Private Sub CommandButton1_Click()
Dim f As Range, mainShtHeaderRng As Range, blankShtHeaderRng As Range, cell As Range
Dim mainSht As Worksheet, blankSht As Worksheet
Set mainSht = Worksheets("mainSht") '<--| set your "main" sheet
Set blankSht = Worksheets("blankSht") '<--| set your "blank" sheet
Set mainShtHeaderRng = mainSht.Rows(1).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| set your header range in the "main" sheet
Set blankShtHeaderRng = blankSht.Rows(1).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<--| set your header range in the "blank" sheet
For Each cell In blankShtHeaderRng '<--| loop through "blank" sheet headers...
Set f = mainShtHeaderRng.Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--|... and search them between the "main" sheet headers
If Not f Is Nothing Then '<--| if found...
Range(f, mainSht.Cells(mainSht.Rows.Count, f.Column).End(xlUp)).Copy '<--| copy "main" sheet corresponding column doqwn to its last non empty cell...
cell.PasteSpecial Paste:=xlPasteFormats '<--| ... and paste formats...
cell.PasteSpecial Paste:=xlPasteValues '<--| ... and values to "blank" sheet current header column
End If
Next cell
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/38148411
复制相关文章
相似问题
腾讯云开发者
