Results 1 to 2 of 2

Thread: Macro to copy and paste solumns to new worksheet

  1. #1

    Macro to copy and paste solumns to new worksheet



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi guys,

    need a macro to copy and paste columns A and B + columns headed "internal manufacturer's guarantee" and "manufacturer's guarantee" to a separate worksheet named "Summary".

    My coding currently only copies and pastes column A and the other 2 columns, not column B

    can anyone help? work restrictions mean i am unable to upload an attachment - but here's the coding i have.

    Code:
    Sub Manufacturersguarantee()
    
      Dim internalmanufacturersguarantee As Variant
      Dim Manufacturersguarantee As Variant
      Dim DstRng As Range
      Dim DstWks As Worksheet
      Dim I As Long
      Dim Info() As Variant
      Dim N As Long
      Dim R As Long
      Dim Rng As Range
      Dim Wks As Worksheet
      
        Set DstWks = Worksheets("Summary")
        Set DstRng = DstWks.Range("A2:C2")
        
        DstWks.UsedRange.Offset(1, 0).ClearContents
        
          For Each Wks In Worksheets
            If Wks.Name <> DstWks.Name Then
               
                Set Manufacturersguarantee = Wks.Rows(1).Find("manufacturer's guarantee", , xlValues, xlPart, xlByColumns, False)
                If Not Manufacturersguarantee Is Nothing Then Manufacturersguarantee = Manufacturersguarantee.Column Else GoTo NextSheet
                
                Set internalmanufacturersguarantee = Wks.Rows(1).Find("internal manufacturer's guarantee", , xlValues, xlPart, xlByColumns, False)
                If Not internalmanufacturersguarantee Is Nothing Then internalmanufacturersguarantee = internalmanufacturersguarantee.Column Else GoTo NextSheet
                
                  ReDim Info(2, Wks.UsedRange.Rows.Count - 1)
                  
                  For R = 2 To Wks.UsedRange.Rows.Count
                    If Wks.Cells(R, Manufacturersguarantee) <> "" Or Wks.Cells(R, internalmanufacturersguarantee) <> "" Then
                       Info(0, I) = Wks.Cells(R, 1)
                       Info(1, I) = Wks.Cells(R, Manufacturersguarantee)
                       Info(2, I) = Wks.Cells(R, internalmanufacturersguarantee)
                       I = I + 1
                    End If
                  Next R
                  
                DstRng.Offset(N, 0).Resize(I + 1, 3).Value = WorksheetFunction.Transpose(Info)
                N = N + I
                I = 0
                
            End If
    NextSheet:
            Err.Clear
            On Error GoTo 0
          Next Wks
          
        Set DstRng = DstRng.Resize(N, 3)
        
        DstRng.Sort Key1:=DstRng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
                    MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      
    End Sub

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,225
    Articles
    57
    Blog Entries
    14
    Excel Version
    Excel Office 365 Insider
    Hi there,

    Can you make a sample file that doesn't use sensitive data and upload that?
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Learn to Master Your Data at the Power Query Academy (the world's most comprehensive online Power Query training) or with my book M is for Data Monkey!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

Posting Permissions

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