使用vba将值从一张纸复制到另一张

我试图将表“Output_Setup”中列A中的所有值复制到“输出”中值不是“”的列B中。

这是我目前的：

Sub Copy() Sheets("Output_Setup").Range("A1:A15000").Copy ActiveWorkbook.Sheets("Output").Range("B3:B15002").PasteSpecial SkipBlanks:=True, Paste:=xlValues End Sub 

在Output_Setup中，大多数单元格都有“”，只有几百个实际值，基本上我希望在输出工作表上过滤出“”，但是我不能使用简单的filter，因为我将使用这些值索引/匹配select。

任何帮助将不胜感激。

谢谢。

Answer 1

你想要做的是复制值不包括零长度的string""吧？
这可能工作：

 With Thisworkbook.Sheets("Output_Setup") .AutoFilterMode = False With .Range("A1:A15000") .AutoFilter Field:= 1, Criteria1:= "<>" .SpecialCells(xlCellTypeVisible).Copy Thisworkbook.Sheets("Output").Range("B3").PasteSpecial xlPasteValues End With .AutoFilterMode = False End With 

没有testing，所以我离开testing给你。
希望这可以帮助你一点。

Answer 2

除非输出顺序很重要，否则可以在输出表中对列B进行sorting，使得空白被强制到底部。

警告！ 未经testing的代码！

 Sub Copy() Sheets("Output_Setup").Range("A1:A15000").Copy ActiveWorkbook.Sheets("Output").Range("B3:B15002").PasteSpecial SkipBlanks:=True, Paste:=xlValues Sheets("Output").Range("B3.B15002").select ActiveWorkbook.Worksheets("Output").Sort.SortFields.Add Key:=Range("B3"), _ Order:=xlAscending, DataOption:=xlSortTextAsNumbers ActiveWorkbook.Worksheets("Output").Sort.Apply End Sub 

Answer 3

你最好在这里决定是否复制一个值的循环。 尝试以下操作：

  Sub CopyValues() application.screenupdating = false 'will speed up process Dim TheOutSheet as Worksheet Dim TheInSheet as Worksheet Dim outRow as long Dim inRow as long inRow = 1 Set TheOutSheet = Sheets("The sheet name you want to pull values from") 'make sure you use quotes Set TheInSheet = Sheets("Sheet to put values into") For outRow = 1 to 15000 '<- this number can be your last row that has a real value, the higher the number the longer the loop. If TheOutSheet.Cells(outRow,1).value <> "" then TheInSheet.Cells(inRow,1).value = TheOutSheet.Cells(outRow,1).value inRow = inRow + 1 end if Next application.screenupdating = True End Sub 

把你的具体的价值，他们需要去（我注意到这些地方给你），并试试看。 如果它不起作用，让我知道它的错误。

Answer 4

您可以使用SpecialCells一次性删除空白而不循环

 Sub Copy() Sheets("Output_Setup").Range("A1:A15000").Copy With Sheets("Output").Range("B3:B15002") .PasteSpecial , Paste:=xlValues On Error Resume Next .SpecialCells(xlBlanks).Delete xlUp On Error GoTo 0 End With End Sub 

Answer 5

您将不得不逐个循环清除“”单元格。 testing代码如下：

 Sub foo() Sheets("Sheet1").Range("A1:A15000").Copy Sheets("Sheet2").Range("A1:A15000").PasteSpecial xlPasteValues Dim x As Range For Each x In Sheets("Sheet2").Range("A1:A15000") If Not IsEmpty(x) Then If x.Value = "" Then x.ClearContents End If End If Next x End Sub