Help with reference between worksheets in VBA

[emmetje]

Hi guys,

I need your help with the following.

I have 2 workbooks, one from 2014 and one from 2015 (that actually is an exact copy of 2014). I need to update the data in 2015 for which I have a fine working code (although I believe some of you could clean it a bit, so if you feel like it, then please do ). But now I want to add a new functionality that gets the value of a single cell which always is the same cell in all the worksheets (Y15) from the 2014 workbook and puts it into another single cell which always is the same cell in all the worksheets (Y4) in the 2015 workbook.


In 'basic' language it would have to look like this:

IF WORKSHEETNAME2014 = WORKSHEETNAME 2015 THEN PASTE Y15 into Y4

Both workbooks have always the same amount of worksheets and also the same name per worksheet. For example:

Workbook 2014: Sheet"Total", Sheet"1", Sheet"2"
Workbook 2015: Sheet"Total", Sheet"1", Sheet"2"

The number of sheets may vary from time to time, but is always the same in both workbooks as 2015 is an exact copy of 2014.


I need you help whith putting this into VBA code. I tried different solutions, but nothing seems to work.

Here is the code (in red the part that needs to work) and I really hope somebody can help soon :

Sub NieuweVakantiekaarten()
'
'TOETSENCOMBI: Ctrl+n
'
'BEVEILIGING WERKBLADEN OPHEFFEN
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect Password:="xxx"
Next
'
'JAARTAL INVOEREN
'
Sheets("Totaal").Select
Range("B3:G3").Select
ActiveCell.FormulaR1C1 = "2015"
Range("B4").Select
'
'BASISBESTAND OPENEN, BLANCO KAART NAAR HUIDIG BESTAND KOPIEREN EN BASISBESTAND SLUITEN
'
Workbooks.Open Filename:= _
"W:\NL\HQ Alkmaar\HR\1. HR ADMINISTRATIE\Overzichten\Vakantiekaarten\2014\_Blanco kaart 2015.xls"
Windows("_Blanco kaart 2015.xls").Activate
Sheets("Blanco kaart").Select
Sheets("Blanco kaart").Copy Before:=Windows("2015_HR.xls").SelectedSheets("Totaal")
Windows("_Blanco kaart 2015.xls").Activate
Windows("_Blanco kaart 2015.xls").Close False
'
'RELEVANTE CELLEN UIT BLANCO KAART KOPIEREN NAAR ALLE WERKBLADEN IN HUIDIG BESTAND EN RESTSALDO VAN VORIG JAAR OPHALEN
'
Sheets("Blanco kaart").Select
Range("D4:G11").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
Sheets("Blanco kaart").Select
Range("D13:G13").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("R4:W10").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("R12:W13").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("R17:W18").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("AB4:AD10").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("AB17:AD17").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("Af4:AG10").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("AF17:AG17").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("AM2:AR13").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("I19:I20").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("D26:AH37").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next

Sheets("Blanco kaart").Select
Range("D43:AH54").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
    
Sheets("Blanco kaart").Select
Range("D60:AH71").Select
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Blanco kaart" And ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next
  
Dim a As Long
For a = 1 To Sheets.Count
    Worksheets(a).Range("Y13:Z13").Value = 0
    Worksheets(a).Range("AF5:AG10").Copy
    Worksheets(a).Range("AF5:AG10").PasteSpecial Paste:=xlPasteValues
    Worksheets(a).Range("AF17:AG17").Copy
    Worksheets(a).Range("AF17:AG17").PasteSpecial Paste:=xlPasteValues
    Worksheets(a).Range("AN6:AO11").Copy
    Worksheets(a).Range("AN6:AO11").PasteSpecial Paste:=xlPasteValues
    Next a

Workbooks.Open Filename:= _
"W:\NL\Common\VakantieKaarten\HR\2014_HR.xls"
Windows("2015_HR.xls").Activate
SELECT SHEET? 
SELECT RANGE? 
IF SHEETNAME2014 = SHEETNAME2015 ??? and ws.Name <> "Totaal" Then
    Selection.Copy Destination:=ws.Cells(Selection.Row, Selection.Column)
    End If
    Next

Sheets("Totaal").Select
Range("A1").Select
  
'
'BLANCO KAART VERWIJDEREN
'
Sheets("Blanco kaart").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
End Sub

Hi guys,

Can someone look at my post with title: Help with reference between worksheets in VBA.

I didn't get any reaction yet. I know I'm a bit impatiance, please forgive me that...

Also forgive me for posting the code the wrong way, I wanted to alter my post but I don't see the edit post button anywhere...

Thanks!

 

[AutoFilterQueen]

Try replacing the red text with this. I think it will do what you need.

    Dim wb14 As Workbook
    Dim wb15 As Workbook
    Dim ws14 As Worksheet
    Dim ws15 As Worksheet
    Set wb14 = Workbooks("2014_HR.xls")
    Set wb15 = Workbooks("2015_HR.xls")
    For Each ws14 In wb14.Sheets
        For Each ws15 In wb15.Sheets
            If ws14.Name = ws15.Name Then
                ws15.Range("Y4") = ws14.Range("Y15")
            End If
        Next ws15
    Next ws14

As for cleaning up your code, my main comment would be that it is not necessary to select cells prior to copying or pasting. That just adds an extra step and can really slow things down when you start to write larger macros.

 

[emmetje]

Thanks!
As soon as I'm back to work on the 23rd of december I'll let you know if it worked.

 

[emmetje]

It worked fine. Thanks!