copy and paste to another sheet

[Mattlake]

Hi

This may have already been asked so apologies if it has.

I have a spreadsheet which i need copy column A, B and column AV from 3 sheets and paste these into a new worksheet. I need to try and set this to happen automatically.

I think this will be a VBA before save (i think) is this actually possible?

if it isnt you can laugh

thank you

Matthew

 

[DanteAmor]

Hello @Mattlake, thanks for posting on the forum.

You omitted some things:
- Like the name of the sheets to copy.
- The name of the new sheet.
- In which row does the data begin?
So fit "s5", "s6" and "s7" by the names of your sheets.
The macro creates a new sheet and names it "new sheet", but you can also adjust it.
The macro copies from row 1 to the last row with data from each sheet and pastes the data below the previous one.

I hope to cover all variants.

Sub copycolumns()
  Dim arr As Variant, itm As Variant
  Dim f As Range
  Dim sh As Worksheet, shNew As Worksheet
  Dim sName As String
  Dim lr As Long
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  sName = "New Sheet"               'Fit to the name of your new sheet
  
  On Error Resume Next: Sheets(sName).Delete: On Error GoTo 0
  Sheets.Add(, Sheets(Sheets.Count)).Name = sName
  Set shNew = Sheets(sName)
  
  lr = 1
  arr = Array("s5", "s6", "s7")     'Fit to the name of your sheets
  For Each itm In arr
    Set sh = Sheets(itm)
    Set f = sh.Range("A:AV").Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
    If Not f Is Nothing Then
      sh.Range("A1:B" & f.Row & ",AV1:AV" & f.Row).Copy
      shNew.Range("A" & lr).PasteSpecial xlPasteValues
      Set f = shNew.Range("A:C").Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
      If Not f Is Nothing Then
        lr = f.Row + 1
      End If
    End If
  Next
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[Mattlake]

Thank you for this. I think it will be easier to just tell the person to make a note of the columns before they adjust it