First of all hello guys,
I´m currently working on a VBA script as you may see from the title. The thing is I only know some basic java and the things I looked up here and there to make my code running.
Now the thing is I want to have two sheets that synchronise.
To be more clear, if you write something in sheet1 and activate the macro it gets copied into the correct fields in sheet2.
My current code looks like this and i guess its the easiest way to get what I want to do:
Sub magic()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("Postenkosten")
Set sh2 = ActiveWorkbook.Sheets("Monatskosten")
Dim Pa As Integer
Dim Pb As Integer
Dim Ma As Integer
Dim Mb As Integer
// go through the designated columns and rows
For Pa = 4 To 34 Step 3
For Pb = 6 To 10 Step 1
// check if they are empty
If sh1.Cells(Pb, Pa).Value <> "" Then
//if not got to sheet2 and look the designated cells there
For Ma = 1 To 30 Step 3
For Mb = 1 To 12 Step 1
//here comes the critical part - if my cell from sheet 1 is the same as the headline (cell) in sheet 2 then...
//if not look for the next headline and compare
If sh1.Cells(Pb, Pa) = sh2.Cells(Ma, 2) Then
//make sure you have a empty row so you don't override things and copy the cells adjacent to sheet 2
If sh2.Cells(Mb, Ma) = "" Then
Else
sh1.Cells(4, Pa).Value.Copy sh2.Cells(Mb, Ma)
sh1.Cells(Pb + 1, Pa).Value.Copy sh2.Cells(Mb + 1, Ma)
sh1.Cells(Pb + 2, Pa).Value.Copy sh2.Cells(Mb + 2, Ma)
End If
End If
Next Mb
Next Ma
End If
Next Pb
Next Pa
End Sub
//go and do this for the next cell in sheet 1
I hope you get what I mean. If you have any ideas how to fix my code I would be very happy (I spent at least a week to make it work)
To further visualise the problem
Thanks a lot for reading and trying to help.
If you need more information don't hesitate to ask I will provide as quick as possible :)
To keep the second Worksheet("Sheet2")
synchronized with Worksheet("Sheet1")
, you may place the VBA Sub
shown below in the Worksheet("Sheet1")
code module:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
r = Target.Row
c = Target.Column
Worksheets("Sheet2").Cells(Target.Row, Target.Column).Value = Target
End Sub
Thus, anything changed in the first Worksheet will be automatically reflected in the second one.
You can further modify this Sub pertinent to your particular requirements, for example setting the Range
that should be reflected by using Intersect
(re: https://msdn.microsoft.com/en-us/library/office/ff839775.aspx )
Hope this may help.
edited after OP's request (see lines with '<=== edited
comment)
maybe you need something like follows
Sub magic()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim postenDates As Range, monatDates As Range, cell As Range, fndRng As Range
Set sh1 = ActiveWorkbook.Worksheets("Postenkosten")
Set sh2 = ActiveWorkbook.Worksheets("Monatskosten")
Set postenDates = SetDatesRange(sh1.Range("D6:D24"), 1, 10, 1, 3) '<== set base range and its "multiplying" factors as per your needs
Set monatDates = SetDatesRange(sh2.Range("A2:AJ2"), 3, 1, 18, 1) '<== set base range and its "multiplying" factors as per your needs
For Each cell In postenDates
Set fndRng = FindDate(cell, monatDates)
If Not fndRng Is Nothing Then
If IsEmpty(fndRng.Offset(13)) Then '<=== edited
With fndRng.End(xlDown) '<=== edited
sh1.Cells(4, cell.Column).Copy '<=== edited
.Offset(1).PasteSpecial xlPasteValues '<=== edited
cell.Offset(, 1).Resize(, 2).Copy '<=== edited
.Offset(1, 1).PasteSpecial xlPasteValues '<=== edited
End With '<=== edited
End If
End If
Next cell
End Sub
Function FindDate(rngToFind As Range, rngToScan As Range) As Range
Dim cell As Range
For Each cell In rngToScan
If cell = rngToFind Then
Set FindDate = cell
Exit For
End If
Next cell
End Function
Function SetDatesRange(iniRng As Range, nRowsSteps As Long, nColsSteps As Long, rowStep As Long, colStep As Long) As Range
Dim unionRng As Range
Dim i As Long, j As Long
Set unionRng = iniRng
With iniRng
For i = 1 To nRowsSteps
For j = 1 To nColsSteps
Set unionRng = Union(unionRng, .Offset((i - 1) * rowStep, (j - 1) * colStep))
Next j
Next i
End With
Set SetDatesRange = unionRng.SpecialCells(xlCellTypeConstants)
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.