Copy and paste specific cells between Workbooks

Dave T · #1 03-29-2023, 04:11 PM

Hello All,

I have been using the following macro to copy various columns to between two workbooks.

The problem I have is that it copies data from every worksheet in the source workbook. The macro copies specific data from the source worksheet - Sheet1 and then copies data from the same range in Sheet2, and so on for each worksheet in the source workbook.
Can someone please edit the macro so that only the data on Sheet1 from the Test - v1 (2023-03-27).xlsm workbook (source) is copied to Sheet1 of the Test (no macros) - v1.xlsx workbook (destination).

Code:

Sub CopyData()
  'https://www.mrexcel.com/board/threads/copy-and-paste-specific-cells-between-workbooks-based-on-criteria.1195526/
  
  'Both Workbooks MUST be open when running the macro.
  
  Dim wb1 As Workbook
  Dim wb2 As Workbook
  Dim ws As Worksheet
  Dim ws1 As Worksheet
  Dim cel As Range
  Dim MyRng As Range
  Dim i As Long
  Dim lrow As Long
  
  Set wb1 = Workbooks("Test - v1 (2023-03-27).xlsm")
  
  Set wb2 = Workbooks("Test (no macros) - v1.xlsx")
  
  Set ws1 = wb2.Sheets("Sheet1")
  
  i = 3
  
  For Each ws In wb1.Worksheets
    lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Set MyRng = ws.Range(ws.Cells(3, 1), ws.Cells(lrow, 1))
    
    For Each cel In MyRng
      If cel <> "" Then
        ws1.Range("A" & i) = cel
        ws1.Range("B" & i) = cel.Offset(0, 1)
        'ws1.Range("C" & i) = cel.Offset(0, 2)  'Column C not included as this is a formula
        ws1.Range("D" & i) = cel.Offset(0, 3)
        ws1.Range("E" & i) = cel.Offset(0, 4)
        ws1.Range("F" & i) = cel.Offset(0, 5)
        ws1.Range("G" & i) = cel.Offset(0, 6)
        ws1.Range("H" & i) = cel.Offset(0, 7)
        ws1.Range("I" & i) = cel.Offset(0, 8)
        ws1.Range("J" & i) = cel.Offset(0, 9)
        ws1.Range("K" & i) = cel.Offset(0, 10)
        i = i + 1
      Else
      End If
    Next cel
  Next ws
End Sub

I know it is associated with the 'For Each ws' part of the macro (worksheet loop), but I cannot work out how to remove this.
As there is no need to go through each worksheet, what needs to be done for the code to work on only one sheet from the source workbook and only one sheet in the destination workbook?

I have attached two workbook, I have been using whilst testing this macro.

Any help appreciated.
Regards, Dave T

NoSparks · #2 03-30-2023, 05:41 AM

Try this

Code:

Sub CopyData()    'Both Workbooks MUST be open when running the macro.
  Dim wb1 As Workbook
  Dim wb2 As Workbook
  Dim ws1 As Worksheet
  Dim cel As Range
  Dim MyRng As Range
  Dim i As Long
  Dim lrow As Long
  
  Set wb1 = Workbooks("Test - v1 (2023-03-27).xlsm")    'Source
  Set wb2 = Workbooks("Test (no macros) - v1.xlsx")     'Destination
  Set ws1 = wb2.Sheets("Sheet1")                        'Destination Sheet1
  i = 3                                                 'First row to copy to
  
  With wb1.Worksheets("Sheet1")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set MyRng = .Range(.Cells(3, 1), .Cells(lrow, 1))
    For Each cel In MyRng
      If cel <> "" Then
        ws1.Range("A" & i) = cel
        ws1.Range("B" & i) = cel.Offset(0, 1)
        'ws1.Range("C" & i) = cel.Offset(0, 2)  'Column C not included as this is a formula
        ws1.Range("D" & i) = cel.Offset(0, 3)
        ws1.Range("E" & i) = cel.Offset(0, 4)
        ws1.Range("F" & i) = cel.Offset(0, 5)
        ws1.Range("G" & i) = cel.Offset(0, 6)
        ws1.Range("H" & i) = cel.Offset(0, 7)
        ws1.Range("I" & i) = cel.Offset(0, 8)
        ws1.Range("J" & i) = cel.Offset(0, 9)
        ws1.Range("K" & i) = cel.Offset(0, 10)
        i = i + 1
      End If
    Next cel
  End With
End Sub

Dave T · #3 03-30-2023, 03:32 PM

Hello NoSparks,

I really appreciate your help.

I had been trying for quite a while to search online for a solution, but it was very difficult.
Using search terms comprised of various words within the original macro, they kept returning the multiple worksheet options, not how to remove parts of the macro so it was worksheet specific.

Thanks again for you help.

Regards,
Dave T

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copy & paste 2 ranges of cells	trevorc	Excel Programming	14	12-02-2018 03:08 PM
Range COPY paste in workbooks sheets as variable	Fean	Excel Programming	3	06-07-2016 06:51 AM
Trying to find a macro that will copy a cell and paste that value to a specific sheet	bryans88	Excel Programming	1	12-23-2015 01:40 PM
Copy/Paste EXCEL cells as pic in WORD	A_Lau	Drawing and Graphics	3	12-19-2014 06:57 AM
Find specific rows then copy and paste to new doc	konopca	Word VBA	5	02-20-2014 02:34 PM