Copying Sheet from one Workbook to another.

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I'm curious if it is possible to copy data from a worksheet to another using VBA.
Example.
I am trying to pull all data in Workbook "OP-AUX Database Test(MacroEnabled)" sheet19 to workbook "SN Log" sheet1.
With the database I have made (with massive help from this community) the macro I have auto logs particular columns on sheets2-17 to sheet19 while removing duplicates. Would there be a way to do this same task but move it to another workbook so there's less clutter and easier logging while also removing duplicates like the following VBA code? I'm currently using the following VBA to capture required information to Sheet19 on the "OP-AUX Database Test(MacroEnabled)" workbook.
VBA Code:
Private Sub Worksheet_Activate()
 Sheet2.Range("K2", Sheet2.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("A2", Sheet19.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("B2:B" & Sheet19.Range("A" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet2.Range("L2", Sheet2.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("c1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("c2", Sheet19.Range("c" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("D2:D" & Sheet19.Range("C" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet3.Range("B2", Sheet3.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("e1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("e2", Sheet19.Range("e" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("F2:F" & Sheet19.Range("E" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet3.Range("C2", Sheet3.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("g1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("g2", Sheet19.Range("g" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("H2:H" & Sheet19.Range("G" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet4.Range("B2", Sheet4.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("i1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("i2", Sheet19.Range("i" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("J2:J" & Sheet19.Range("I" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet4.Range("C2", Sheet4.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("k1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("k2", Sheet19.Range("k" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("L2:L" & Sheet19.Range("K" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet5.Range("B2", Sheet5.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("m1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("m2", Sheet19.Range("m" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("N2:N" & Sheet19.Range("M" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet6.Range("B2", Sheet6.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("o1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("o2", Sheet19.Range("o" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("P2:P" & Sheet19.Range("O" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet6.Range("C2", Sheet6.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("q1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("q2", Sheet19.Range("q" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("R2:R" & Sheet19.Range("Q" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet7.Range("B2", Sheet7.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("s1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("s2", Sheet19.Range("s" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("T2:T" & Sheet19.Range("S" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet7.Range("C2", Sheet7.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("u1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("u2", Sheet19.Range("u" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("V2:V" & Sheet19.Range("U" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet8.Range("B2", Sheet8.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("w1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("w2", Sheet19.Range("w" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("X2:X" & Sheet19.Range("W" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet8.Range("C2", Sheet8.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("y1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("y2", Sheet19.Range("y" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("Z2:Z" & Sheet19.Range("Y" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet9.Range("B2", Sheet9.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("aa1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("aa2", Sheet19.Range("aa" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AB2:AB" & Sheet19.Range("AA" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet9.Range("C2", Sheet9.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ac1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ac2", Sheet19.Range("ac" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AD2:AD" & Sheet19.Range("AC" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet10.Range("B2", Sheet10.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ae1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ae2", Sheet19.Range("ae" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AF2:AF" & Sheet19.Range("AE" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet11.Range("B2", Sheet11.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ag1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ag2", Sheet19.Range("ag" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AH2:AH" & Sheet19.Range("AG" & Rows.Count).End(xlUp).Row).Value = Date


 Sheet12.Range("B2", Sheet12.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ai1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ai2", Sheet19.Range("Ai" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AJ2:AJ" & Sheet19.Range("AI" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet13.Range("B2", Sheet13.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ak1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ak2", Sheet19.Range("Ak" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AL2:AL" & Sheet19.Range("AK" & Rows.Count).End(xlUp).Row).Value = Date

 Sheet14.Range("H2", Sheet14.Range("H" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Am1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Am2", Sheet19.Range("Am" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AN2:AN" & Sheet19.Range("AM" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet14.Range("I2", Sheet14.Range("I" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ao1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ao2", Sheet19.Range("Ao" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AP2:AP" & Sheet19.Range("AO" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet15.Range("B2", Sheet15.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Aq1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Aq2", Sheet19.Range("Aq" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AR2:AR" & Sheet19.Range("AQ" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet15.Range("C2", Sheet15.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("As1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("As2", Sheet19.Range("As" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AT2:AT" & Sheet19.Range("AS" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet16.Range("K2", Sheet16.Range("K" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Au1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Au2", Sheet19.Range("Au" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AV2:AV" & Sheet19.Range("AU" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet16.Range("L2", Sheet16.Range("L" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Aw1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Aw2", Sheet19.Range("Aw" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AX2:AX" & Sheet19.Range("AW" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet16.Range("M2", Sheet16.Range("M" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("Ay1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("Ay2", Sheet19.Range("Ay" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("AZ2:AZ" & Sheet19.Range("AY" & Rows.Count).End(xlUp).Row).Value = Date
 
 Sheet17.Range("B2", Sheet17.Range("B" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("ba1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("ba2", Sheet19.Range("ba" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("BB2:BB" & Sheet19.Range("BA" & Rows.Count).End(xlUp).Row).Value = Date
 Sheet17.Range("C2", Sheet17.Range("C" & Rows.Count).End(xlUp)).Copy
 Sheet19.Range("bc1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 Sheet19.Range("bc2", Sheet19.Range("bc" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 Sheet19.Range("BD2:BD" & Sheet19.Range("AC" & Rows.Count).End(xlUp).Row).Value = Date
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,479
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Wow, that is a lot of code! Check if the following code is a step in the right direction though:

VBA Code:
    Dim wbCopy As Worksheet
    Dim wbDestws As Worksheet
'
    Set WbCopy = Workbooks("OP-AUX Database Test(MacroEnabled).xlsm")
    Set WbDestWs = Workbooks("SN Log.xlsm").Worksheets("Sheet19")
'
'
'-- 1st example \/ \/ --
'
'   Copy range to clipboard
    WbCopy.Worksheets("Sheet2").Range("K2", Sheet2.Range("K" & Rows.Count).End(xlUp)).Copy
'
'   PasteSpecial to paste values, formulas, formats, etc.
    WbDestWs.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    WbDestWs.Range("A2", WbDestWs.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
    WbDestWs.Range("B2:B" & WbDestWs.Range("A" & Rows.Count).End(xlUp).Row).Value = Date

And why are you doing that whole 1048576 stuff? That max row (1048576) stuff is not needed.
 

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Yeah, it's a lot of repetition as far as the code comes to play. This is a serial number generator for nicelabel software so each line has a specific to information that goes on the labels. As for the "1048576" stuff I am using code that was graciously given to me and since it works I hadn't given much more thought as to why it was there. I will certainly give this a try if I get the opportunity today how ever I am usually fairly busy on Thursdays doing my actual job which is shipping and receiving :) I'll give an example file at the bottom to show how it currently works.
This is the first sheet. It the basis for everything and is the only place to change criteria for the serial numbers.
Test full DB (Macro Enabled).xlsm
ABCDEF
1YearMonthStart #CountIf you want to auto log S/N's then enable
221510macro workbook and click the LOG sheet.
3Only GREEN numbers are changable. Read notes :)Logging not needed for generating S/N's.
4AUX Item
5ItemDescRev FormatCompanyPart No.Page
6ItemDescCompanyPartNoAUX CK-EXT
7ItemDescCompanyPartNoAUX CK-INT
8ItemDescCompanyPartNoAUX EDO
9ItemDescCompanyPartNoAUX GL-EXT
10ItemDescCompanyPartNoAUX GL-INT
11ItemDescCompanyPartNo
12ItemDescCompanyPartNoAUX MDC+SPEC
13ItemDescCompanyPartNo
14ItemDescRev. Level A B C D E F G H I JCompanyPartNo
15ItemDescRev. Level A B C D E F G H I JCompanyPartNo
16ItemDescCompanyPartNoAUX MLS+MKS
17ItemDescCompanyPartNo
18ItemDescCompanyPartNo
19ItemDescCompanyPartNoAUX SLRU+DMCU
20ItemDescCompanyPartNo
21OP Item
22ItemDescA B C D ECompanyPartNoOP1
23ItemDescF G H I JCompanyPartNo
24ItemDescCompanyPartNoOP3
25ItemDescCompanyPartNo
26ItemDescCompanyPartNoOP4
27ItemDescCompanyPartNo
28ItemDescCompanyPartNoOP5
29ItemDescCompanyPartNoOP6
30ItemDescCompanyPartNo
31ItemDescCompanyPartNoOP7
32ItemDescCompanyPartNo
33ItemDescCompanyPartNoOP8
34ItemDescCompanyPartNo
35ItemDescCompanyPartNoOP9
36ItemDescCompanyPartNo
Main


It links up to 17 other sheets like following in similar format.

Test full DB (Macro Enabled).xlsm
ABCDEFGHIJKL
1No.Serial No. LHSerial No. RHDescription LHDescription RHRev. A-ERev. F-J Company NamePart No. LHPart No. RHDOLDOR
2#####CALC!#CALC!#CALC!#CALC!#CALC!#CALC!#CALC!#CALC!#CALC!#CALC!#CALC!
3
OP1
Cell Formulas
RangeFormula
A2A2=Main!G1&TEXT(SEQUENCE(Main!D2),"000")
B2B2=Main!A22&Main!A2&Main!B2&TEXT(SEQUENCE(Main!D2)+Main!C2-1,"000")
C2C2=Main!A23&Main!A2&Main!B2&TEXT(SEQUENCE(Main!D2)+Main!C2-1,"000")
D2D2=Main!B22&TEXT(SEQUENCE(Main!D2),"")
E2E2=Main!B23&TEXT(SEQUENCE(Main!D2),"")
F2F2=Main!C22&TEXT(SEQUENCE(Main!D2),"")
G2G2=Main!C23&TEXT(SEQUENCE(Main!D2),"")
H2H2=Main!D22&TEXT(SEQUENCE(Main!D2),"")
I2I2=Main!E22&TEXT(SEQUENCE(Main!D2),"")
J2J2=Main!E23&TEXT(SEQUENCE(Main!D2),"")
K2K2=K1&Main!A2&Main!B2&TEXT(SEQUENCE(Main!D2)+Main!C2-1,"000")
L2L2=L1&Main!A2&Main!B2&TEXT(SEQUENCE(Main!D2)+Main!C2-1,"000")

This all creates a "Database" in which nicelabel pulls from the create labels.
All of this is saved using my first posts VBA code to pull from specific lines for just the serial numbers themselves. Which is the sheet I would like to pull to a separate workbook. I digress though. I must be getting to work but, I will definitely try this out in any downtime I get and let you know how it goes. Thanks for taking the time to look over it for me.
 

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Sorry for the double post. If the edit window wasn't so short I would have done that instead. I'm simply not sure where to put that in. I've never linked two workbooks together before.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,479
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

Another question. Are you wanting to copy the data from the various worksheets directly to sheet1 of the other workbook, or are you wanting to copy like you currently have it to sheet 19 and also to sheet1 of the other workbook?
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,479
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@PuntingJawa Try the following shortened code to verify it works just like your current code you submitted:

VBA Code:
'
' This section HAS to be placed at the very top of your module ;)
'
Public ColumnToCopyFrom As String
Public ColumnToCopyTo   As String
Public DateColumn       As String
Public SheetToCopyFrom  As String
Public SheetToCopyTo    As String
'
'

Sub CopyPasteEtc()
'
    Sheets(SheetToCopyFrom).Range(ColumnToCopyFrom & "2", Sheets(SheetToCopyFrom).Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
    Sheets(SheetToCopyTo).Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
    Sheets(SheetToCopyTo).Range(ColumnToCopyTo & "2", Sheets(SheetToCopyTo).Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
    Sheets(SheetToCopyTo).Range(DateColumn & "2:" & DateColumn & Sheets(SheetToCopyTo).Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column

End Sub

Private Sub Worksheet_Activate_V2()
'
'    Dim wsCopy      As Worksheet
'    Dim wsDest      As Worksheet
'
'    Set wsCopy = Workbooks("OP-AUX Database Test(MacroEnabled).xlsm").Worksheets("Sheet19")
'    Set wsDest = Workbooks("SN Log.xlsm").Worksheets("Sheet1")
'
'
    SheetToCopyTo = "Sheet19"
'
'
    SheetToCopyFrom = "Sheet2": ColumnToCopyFrom = "K": ColumnToCopyTo = "A": DateColumn = "B"  '-- Sheet2 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet2": ColumnToCopyFrom = "L": ColumnToCopyTo = "C": DateColumn = "D"  '-- Sheet2 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet3": ColumnToCopyFrom = "B": ColumnToCopyTo = "E": DateColumn = "F"  '-- Sheet3 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet3": ColumnToCopyFrom = "C": ColumnToCopyTo = "G": DateColumn = "H"  '-- Sheet3 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet4": ColumnToCopyFrom = "B": ColumnToCopyTo = "I": DateColumn = "J"  '-- Sheet4 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet4": ColumnToCopyFrom = "C": ColumnToCopyTo = "K": DateColumn = "L"  '-- Sheet4 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet5": ColumnToCopyFrom = "B": ColumnToCopyTo = "M": DateColumn = "N"  '-- Sheet5 to Sheet19
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet6": ColumnToCopyFrom = "B": ColumnToCopyTo = "O": DateColumn = "P"  '-- Sheet6 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet6": ColumnToCopyFrom = "C": ColumnToCopyTo = "Q": DateColumn = "R"  '-- Sheet6 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet7": ColumnToCopyFrom = "B": ColumnToCopyTo = "S": DateColumn = "T"  '-- Sheet7 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet7": ColumnToCopyFrom = "C": ColumnToCopyTo = "U": DateColumn = "V"  '-- Sheet7 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet8": ColumnToCopyFrom = "B": ColumnToCopyTo = "W": DateColumn = "X"  '-- Sheet8 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet8": ColumnToCopyFrom = "C": ColumnToCopyTo = "Y": DateColumn = "Z"  '-- Sheet8 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet9": ColumnToCopyFrom = "B": ColumnToCopyTo = "AA": DateColumn = "AB"    '-- Sheet9 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet9": ColumnToCopyFrom = "C": ColumnToCopyTo = "AC": DateColumn = "AD"    '-- Sheet9 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet10": ColumnToCopyFrom = "B": ColumnToCopyTo = "AE": DateColumn = "AF"   '-- Sheet10 to Sheet19
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet11": ColumnToCopyFrom = "B": ColumnToCopyTo = "AG": DateColumn = "AH"   '-- Sheet11 to Sheet19
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet12": ColumnToCopyFrom = "B": ColumnToCopyTo = "AI": DateColumn = "AJ"   '-- Sheet12 to Sheet19
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet13": ColumnToCopyFrom = "B": ColumnToCopyTo = "AK": DateColumn = "AL"   '-- Sheet13 to Sheet19
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet14": ColumnToCopyFrom = "H": ColumnToCopyTo = "AM": DateColumn = "AN"   '-- Sheet14 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet14": ColumnToCopyFrom = "I": ColumnToCopyTo = "AO": DateColumn = "AP"   '-- Sheet14 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet15": ColumnToCopyFrom = "B": ColumnToCopyTo = "AQ": DateColumn = "AR"   '-- Sheet15 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet15": ColumnToCopyFrom = "C": ColumnToCopyTo = "AS": DateColumn = "AT"   '-- Sheet15 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet16": ColumnToCopyFrom = "K": ColumnToCopyTo = "AU": DateColumn = "AV"   '-- Sheet16 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet16": ColumnToCopyFrom = "L": ColumnToCopyTo = "AW": DateColumn = "AX"   '-- Sheet16 to Sheet19 Pt. 2
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet16": ColumnToCopyFrom = "M": ColumnToCopyTo = "AY": DateColumn = "AZ"   '-- Sheet16 to Sheet19 Pt. 3
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet17": ColumnToCopyFrom = "B": ColumnToCopyTo = "BA": DateColumn = "BB"   '-- Sheet17 to Sheet19 Pt. 1
    Call CopyPasteEtc
'
    SheetToCopyFrom = "Sheet17": ColumnToCopyFrom = "C": ColumnToCopyTo = "BC": DateColumn = "BD"   '-- Sheet17 to Sheet19 Pt. 2
    Call CopyPasteEtc
End Sub

This format should be much easier to make changes to.
 

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows

ADVERTISEMENT

Another question. Are you wanting to copy the data from the various worksheets directly to sheet1 of the other workbook, or are you wanting to copy like you currently have it to sheet 19 and also to sheet1 of the other workbook?
To answer this. Truthfully I'd be perfectly fine just copying sheet 19 as a whole since it's already set and it would shorten the code on the log workbook. Every year I plan on making a copy and resetting the information and changing the name of the file to a specific year. I definitely won't have time tomorrow to play around with it due to getting hit hard with orders to ship out tomorrow before the holiday weekend but I should have a chance on Tuesday to jump on it and see if it'll work. Thanks for your help and whatever is easiest or if you figure out something interesting or that you'd like to try feel free to give any input. The things that can be done in excel are interesting and I'm happy for all the knowledge I can get. Keep in mind that I need it to remove duplicate entries.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,479
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@PuntingJawa I don't think you answered my question. Let me rephrase it, Do you want/need the results in Sheet19 as well as Sheet1 in the other workbook? The alternative is to bypass putting results into Sheet19 and put all results directly into Sheet1 of the other workbook. If you want/need both Sheet19 and the other workbook Sheet1 you could copy Sheet19, after it has been updated, over to Sheet1 in the other workbook.

The end result of Sheet1 in the other workbook should be the same as Sheet19 results, either way you choose.

The answers you provide are why I submitted the last code that I provided. It should be fairly easy adapted to convert to what your answer is.

FYI, the last code I provided as a shortened version should also handle the removal of duplicates that you mentioned. That is why I asked you to test it to verify everything is working in the shortened code.
 
Last edited:

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Oooh! Sorry I misunderstood. I was in bed reading emails on mobile so as you can imagine I was rather tired. Yes, bypassing sheet 19 would be quite nice and allow me to remove it entirely.
 

PuntingJawa

New Member
Joined
Feb 25, 2021
Messages
45
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I may be placing the codes in wrong
1621619421685.png
 

Forum statistics

Threads
1,144,340
Messages
5,723,804
Members
422,518
Latest member
quack_quack

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
Top