CODEWITHSUNDEEP
vbaexcel
tweed85
tweed85

Reputation: 23

Copying values from one sheet to another using vba

I'm trying to copy all the values in column A in sheet "Output_Setup" to column B in "Output" where the value is not "".

This is what I have currently:

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

In Output_Setup most of the cells have "" and there are only a few hundred with a real value, basically I want the "" filtered out on the Output worksheet but I can't use a simple filter because I will be using these values for an index/match selection.

Any help would be greatly appreciated.

Thanks.

Upvotes: 2

Views: 1893

Answers (5)

L42
L42

Reputation: 19737

What you want to do is copy values excluding zero length strings "" right?
This might work:

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

Not tested so i leave the testing to you.
Hope this helps you a bit.

Upvotes: 0

brettdj
brettdj

Reputation: 55702

You can use SpecialCells to remove the blanks in a single shot without looping

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

Upvotes: 1

Tronald
Tronald

Reputation: 1585

You best bet here is a loop that decides whether to copy a value or not. Try the following:

    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

Put your specific values where they need to go (I noted those areas for you) and give it a try. If it doesn't work let me know where it errors.

Upvotes: 1

Alex Godofsky
Alex Godofsky

Reputation: 708

You are going to have to loop individually to clear the "" cells. Tested code below:

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

Upvotes: 0

ApeWithPants
ApeWithPants

Reputation: 104

Unless order of the output matters, you could sort column B in the output sheet in such a way that the blanks are forced to the bottom.

WARNING! UNTESTED CODE!

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

Upvotes: 1

Related Questions