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.

    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
            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
    Nanaimo, BC, Canada
    Blog Entries
    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

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

    Main Site: -||- Blog: -||- 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