Copy paste data from multiple sheets onto one sheet

Mr_Peter

New Member
Joined
Nov 14, 2022
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi all, please will someone help assist me with this VBA macro I am struggling to write. I have a workbook with multiple worksheets containing data, the aim of this VBA macro is to copy data from all the different worksheets into one worksheet that I will call "Historical", as a place to consolidate all the data gathered. So in the picture below, I need to copy the data from worksheet "Lesotho" and paste it onto the worksheet "Historical". The data that needs to be copied is Range("D2:E41"), the "Historical" worksheet will have all the headings in column "B" already.

ExcelTable_Example3.png


Here is a picture of what I want it to look like after the data is copied from the worksheet "Lesotho" to "Historical".

ExcelTable_Example4.png


I also need data from another worksheet copied and pasted below the data for "Lesotho" on the "Historical" worksheet, so in this case data from "Uganda" where the range is ("D2:E61") needs to be pasted below the data from "Lesotho" on the "Historical" worksheet, where it will look like this:

ExcelTable_Example5.png


The data from "Uganda" needs to be pasted into Range("C42:D101") on the "Historical" worksheet, below the data from "Lesotho". The last part I am looking to do with this VBA macro is to have the macro copy paste data every new week, in the pictures posted the date is 6 November 2022, there will be another macro that hides columns "C" and "D". I now need this same copy paste macro to copy data from range ("F2:G61") on "Lesotho" and paste it after the data already on "Historical". This picture below is the "Lesotho" worksheet with columns "C" and "D" hidden.

ExcelTable_Example6.png


Here is what I want it to look like after the data is copied onto the worksheet "Historical".

ExcelTable_Example7.png


The data for range ("F2:G41") from worksheet "Lesotho" is pasted into range ("E2:F41") on the worksheet "Historical", the macro would also copy data from "Uganda" where columns "C" and "D" would be hidden, copying range ("F2:G61") from "Uganda" and pasting it to range ("E42:F101") on "Historical". Would it be possible to write this VBA macro? I am not sure on the limitations for Excel VBA, and it seems like this is a long macro to write since I am consolidating data from multiple worksheets into one worksheet, on top of one another where I am hiding columns in the other worksheets as well. Please and thank you in advance if anyone is able to assist me. Apologies for the long post as I am quite new to Excel VBA. Thank you again!
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
If you can do it by hand you can do it with VBA.

But what does the code need to do? Go through the tables and copy those columns that have a planned and actual column for a date?
Or only copy (add) those columns that belong to a given date (for instance once every week, for the previous week)?
 
Upvote 0
Hi sijpie, thank you for your response. I managed to solve my query after utilising the services of someone on fiverr. Here is the code for both macros below to give some context, the first macro that hides 2 columns to the right of "B3" then inserts a new column between the next 2 columns and adds a column at the end of the range. I realised that the VBA code is a lot more complex than I had hoped for.

VBA code for first macro that hides columns:

VBA Code:
Sub program_macro1()
Dim last_col As Long
Dim actws As Worksheet
Application.ScreenUpdating = False
For i = 1 To ThisWorkbook.Sheets.Count
    Set actws = ThisWorkbook.Sheets(i)
    actws.Activate
    If actws.Name <> "Historical" And actws.Name <> "Historical_GHANA_SA" And actws.Visible = True Then
        last_col = actws.Cells(3, actws.Columns.Count).End(xlToLeft).Column
        For j = 3 To last_col
            If actws.Columns(j).Hidden = False Then
                col_vis = j
                Exit For
            End If
        Next j

        actws.Range(actws.Columns(col_vis), actws.Columns(col_vis + 1)).EntireColumn.Hidden = True
    actws.Columns(col_vis + 3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     actws.Cells(2, col_vis + 2).Value = "Planned"
     actws.Cells(2, col_vis + 3).Value = "Actuals"

    actws.Cells(3, col_vis + 2).Copy
    actws.Cells(3, col_vis + 3).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

     last_col = actws.Cells(3, actws.Columns.Count).End(xlToLeft).Column

     actws.Columns(last_col).Copy
     actws.Columns(last_col + 1).Select
     actws.Paste
    Application.CutCopyMode = False
    actws.Cells(1, 1).Select
    actws.Range(actws.Cells(4, last_col + 1), actws.Cells(40000, last_col + 1)).ClearContents

    End If
Next i
Application.ScreenUpdating = True
MsgBox "Process Completed!", vbInformation
End Sub

VBA code for second macro that copies data from tabs:

VBA Code:
Sub program_macro2()
Dim last_col As Long
Dim actws As Worksheet, histws As Worksheet, start_row As Long, new_col As Long, last_row As Long
Application.ScreenUpdating = False
For i = 1 To ThisWorkbook.Sheets.Count
    Set actws = ThisWorkbook.Sheets(i)
        actws.Activate
    If actws.Name <> "Historical" And actws.Name <> "Historical_GHANA_SA" And actws.Visible = True Then
        If actws.Name <> "Ghana" And actws.Name <> "South Africa" Then
            Set histws = ThisWorkbook.Sheets("Historical")
        Else
            Set histws = ThisWorkbook.Sheets("Historical_GHANA_SA")
        End If
            
            
            start_row = 0
            On Error Resume Next
            start_row = Application.Match(actws.Name, histws.Columns(2), 0)
            On Error GoTo 0
            new_col = histws.Cells(start_row, histws.Columns.Count).End(xlToLeft).Column + 1
            
            If start_row > 0 Then
                    last_col = actws.Cells(3, actws.Columns.Count).End(xlToLeft).Column
                    last_row = actws.Cells(actws.Rows.Count, 2).End(xlUp).Row
                    For j = 3 To last_col
                        If actws.Columns(j).Hidden = False Then
                            col_vis = j
                            Exit For
                        End If
                    Next j
                
                    'copy paste data
                    actws.Range(actws.Cells(2, col_vis), actws.Cells(last_row, col_vis + 1)).Copy
                    histws.Activate
                    histws.Cells(start_row, new_col).Select
                    
                    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                    , SkipBlanks:=False, Transpose:=False
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                     Application.CutCopyMode = False
                     
                         histws.Range(histws.Columns(new_col), histws.Columns(new_col + 1)).EntireColumn.AutoFit
            End If
    
    
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Process Completed!", vbInformation
End Sub

Thanks so much for your reply, my questions have been solved for now but I will be sure to ask if I have any more queries in the future!
 
Upvote 0
Solution

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top