+ Reply to Thread
Results 1 to 2 of 2

Vba code to copy and paste second visible cell to other worksheet range then the next

Hybrid View

  1. #1
    Registered User
    Join Date
    05-29-2012
    Location
    Afghanistan
    MS-Off Ver
    Excel 2010
    Posts
    13

    Question Vba code to copy and paste second visible cell to other worksheet range then the next

    Hi all,

    I have a filtered worksheet say worksheet2. I want to copy the second visible cell in a column to a range in worksheet 2, then do the same with the 3rd visible cell, i have a part code shown below but it copies hidden cells. Any help much appreciated. I also only want to copy paste the value in the visible cells.

    Sub Macro2()
    
        Sheets("Data-2").Range ("A1")
        ActiveSheet.Range("$A$1:$P$65565").AutoFilter Field:=1, Criteria1:= _
            "Jalalabad 1"
        ActiveWorkbook.Worksheets("Data-2").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Data-2").AutoFilter.Sort.SortFields.Add Key:=Range _
            ("C1:C15"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Data-2").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Sheet4.Range("I3").Copy
        Sheet1.Range("M62").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("I4").Copy
        Sheet1.Range("M63").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("I5").Copy
        Sheet1.Range("M64").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("F3").Copy
        Sheet1.Range("M47").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("F4").Copy
        Sheet1.Range("M46").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("F5").Copy
        Sheet1.Range("M45").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("J3").Copy
        Sheet1.Range("E84").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("J4").Copy
        Sheet1.Range("E83").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("J6").Copy
        Sheet1.Range("E82").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("K3").Copy
        Sheet1.Range("G84").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("K4").Copy
        Sheet1.Range("G83").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("K6").Copy
        Sheet1.Range("G82").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("L3").Copy
        Sheet1.Range("J84").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("L4").Copy
        Sheet1.Range("J83").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("L5").Copy
        Sheet1.Range("J82").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("M3").Copy
        Sheet1.Range("K84").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("M4").Copy
        Sheet1.Range("K83").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("M6").Copy
        Sheet1.Range("K82").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("N3").Copy
        Sheet1.Range("N84").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("N4").Copy
        Sheet1.Range("N83").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("N6").Copy
        Sheet1.Range("N82").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheet4.Range("$A$2:$P$65565").AutoFilter Field:=1
    End Sub

  2. #2
    Forum Expert JBeaucaire's Avatar
    Join Date
    03-21-2004
    Location
    Bakersfield, CA
    MS-Off Ver
    2010, 2016, Office 365
    Posts
    33,492

    Re: Vba code to copy and paste second visible cell to other worksheet range then the next

    Shot in the dark here:

    Option Explicit
    
    Sub Macro2()
    Dim LR As Long
    
        Sheets("Data-2").Range ("A1")
        ActiveSheet.Range("$A$1:$P$65565").AutoFilter Field:=1, Criteria1:= _
            "Jalalabad 1"
        ActiveWorkbook.Worksheets("Data-2").AutoFilter.Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Data-2").AutoFilter.Sort.SortFields.Add Key:=Range _
            ("C1:C15"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Data-2").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        With Sheet4
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("I2:I" & LR).Copy
            Sheet1.Range("M62").PasteSpecial xlPasteValues
            .Range("F2:F" & LR).Copy
            Sheet1.Range("M45").PasteSpecial xlPasteValues
            .Range("J2:J" & LR).Copy
            Sheet1.Range("E82").PasteSpecial xlPasteValues
            .Range("K2:K" & LR).Copy
            Sheet1.Range("G82").PasteSpecial xlPasteValues
            .Range("L2:L" & LR).Copy
            Sheet1.Range("J82").PasteSpecial xlPasteValues
            .Range("M2:M" & LR).Copy
            Sheet1.Range("K82").PasteSpecial xlPasteValues
            .Range("N2:N" & LR).Copy
            Sheet1.Range("N82").PasteSpecial xlPasteValues
            .Range("$A$2:$P$65565").AutoFilter Field:=1
        End With
        
    End Sub
    _________________
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    If you've been given good help, use the icon below to give reputation feedback, it is appreciated.
    Always put your code between code tags. [CODE] your code here [/CODE]

    ?None of us is as good as all of us? - Ray Kroc
    ?Actually, I *am* a rocket scientist.? - JB (little ones count!)

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1